【发布时间】：2019-01-31 02:04:36
【问题描述】：
我正在尝试让 powerpoint 打开在文件夹中找到最新的文本文件，用 excel 打开文本文件，格式化文本文件，然后将文件另存为 xlsx。然后，最终文档将在 powerpoint 演示文稿中更新。
我遇到的问题是代码将运行一次并按预期执行。然后在下一次迭代 powerpoint 崩溃。看来代码与 excel 保持联系，我不知道如何在代码结束时切断它。有什么想法吗？
Sub ImportFormatIN3()
Dim MyPath As String
Dim TargetFolder As String
Dim MyFile As String
Dim LatestFile As String
Dim latestDate As Date
Dim LMD As Date
'Defined path to reports
MyPath = "R:\filelocation\"
TargetFolder = "C:\midfilelocation\FinalIN3.txt"
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
MyFile = Dir(MyPath & "*.txt")
If Len(MyFile) = 0 Then
Exit Sub
End If
'Find the newest file in the mypath
Do While Len(MyFile) > 0
LMD = FileDateTime(MyPath & MyFile)
If LMD > latestDate Then
LatestFile = MyFile
latestDate = LMD
End If
MyFile = Dir
Loop
FileCopy MyPath & LatestFile, TargetFolder
Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
xlApp.Workbooks.Add
xlApp.Visible = True
'On Error Resume Next
With xlApp.ActiveSheet.QueryTables.Add(Connection:="TEXT;midfilelocation\FinalIN3.txt", Destination:=Range("A1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(4, 10, 10, 9, 18, 15, 23, 32, 12, 5, 7, 13, 9, 6)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Rows("1:9").Select
Selection.Delete Shift:=xlUp
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Rows("2:2").Select
Selection.Delete Shift:=xlUp
Range("M:M,N:N").Select
Range("N1").Activate
Selection.Delete Shift:=xlToLeft
Columns("K:K").Select
Selection.Delete Shift:=xlToLeft
Range("F20").Select
Columns("D").EntireColumn.Delete
Columns("H").EntireColumn.Delete
Columns("I").EntireColumn.Delete
Columns("G").EntireColumn.Delete
Columns("C").EntireColumn.Delete
Columns("A").EntireColumn.Delete
Columns("A").ColumnWidth = 25
Columns("B").ColumnWidth = 25
Columns("C").ColumnWidth = 30
Columns("D").ColumnWidth = 60
Columns("E").ColumnWidth = 15
Range("A1:E1").EntireRow.Insert
Range("A1:E1").Merge
Range("A:E").HorizontalAlignment = xlCenter
Range("A:E").Font.Size = 15
Range("A1").Font.Size = 30
Range("A1").Value = "IN3 Dispatch as of " & latestDate
Dim KillConnects As Long
With ActiveWorkbook
For KillConnects = .Connections.Count To 1 Step -1
.Connections(KillConnects).Delete
Next KillConnects
End With
ActiveWorkbook.SaveAs FileName:="C:\finalfilelocation\FinalIN3Document.xlsx", AccessMode:=xlExclusive, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
ActiveWorkbook.Close
xlApp.Workbooks.Close
End Sub
【问题讨论】：
-
所有 Excel 对象都需要完全限定。 PowerPoint 对 Excel
Range、Column等一无所知。我还将消除对ActiveSheet、Select、Selection等的依赖，并将变量设置为所需的对象。使用xlApp.Quit关闭创建的Excel实例 -
您需要在 Excel 变量关闭后将其设置为空来清除它。
Set xlApp = Nothing。这应该可以解决问题。 -
感谢您的回复。我相信“With xlApp.ActiveSheet.QueryTables.Add(Connection:="TEXT;midfilelocation\FinalIN3.txt", Destination:=Range("A1"))'code' 是问题所在。我阅读了最简单的方法使用宏将非分隔文本文件排序到 excel 中，所以我就是这样做的。有没有更好的方法来处理这个问题？抱歉，我不知道如何使代码标签在 cmets 中工作......
-
cmets 中的代码标记是一个 ` 字符，后跟一个结束符，结尾没有空格 例如：`
codehere`
标签： excel vba powerpoint