我有一个宏,用于从目录中的许多excel工作簿导入数据。它在Excel2003中运行得很好,但由于我最近升级到Excel2010,宏似乎不起作用。激活后,宏不会出错或产生任何内容。我已经更改了所有的信任中心设置,我拥有的其他宏(不导入数据宏)运行良好。我不太擅长编写VBA,也看不出问题出在哪里。看起来excel只是试图运行宏,跳过它曾经做过的所有事情并完成。非常感谢您的帮助。谢谢
Sub GDCHDUMP()
Dim lCount As Long
Dim wbResults As Workbook
Dim twbk As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error Resume Next
Set twbk = ThisWorkbook
With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = "R:ServCoordGCMData OperationsQualityGDCHDump"
.filename = "*.xls*"
If .Execute > 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all
'Open Workbook x and Set a Workbook variable to it
Set wbResults = Workbooks.Open(filename:=.FoundFiles(lCount), UpdateLinks:=0)
Set ws = wbResults.Sheets(1)
ws.Range("B2").Copy
twbk.Sheets(1).Cells(lCount, 1).PasteSpecial xlPasteValues
wbResults.Close SaveChanges:=False
'There was a lot more lines like the 2 above that I removed for clarity
Next lCount
End If
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
On Error Resume Next
应该真正避免,除非需要。这就像告诉Excel Shut Up
。主要问题是xl2007+不支持Application.FileSearch
您可以改用Application.GetOpenFilename
。
请参见此示例。(未测试)
Option Explicit
Sub GDCHDUMP()
Dim lCount As Long
Dim wbResults As Workbook, twbk As Workbook
Dim ws As Worksheet
Dim strPath As String
Dim Ret
Dim i As Long
strPath = "R:ServCoordGCMData OperationsQualityGDCHDump"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Set twbk = ThisWorkbook
ChDir strPath
Ret = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , , , True)
If TypeName(Ret) = "Boolean" Then Exit Sub
For i = LBound(Ret) To UBound(Ret)
Set wbResults = Workbooks.Open(Filename:=Ret(i), UpdateLinks:=0)
Set ws = wbResults.Sheets(1)
ws.Range("B2").Copy
'twbk.Sheets(1).Cells(lCount, 1).PasteSpecial xlPasteValues
wbResults.Close SaveChanges:=False
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub