在Excel 2010中使用VBA
我们一直在使用Excel 2003的VBA代码多年。我有大约70个文件，我从中提取信息并将其编译到一个电子表格中。 这一次，它只承认70中的3个。我没有得到任何错误。 我注意到，所有3个认可的是旧版本“.xls”。 所有不被认可的是“.xlsx”。 下面是我认为导致问题的部分代码。 谁能帮忙？
Public currApp As String Public i As String Public recordC As String Public excelI As Integer Public intFileHandle As Integer Public strRETP As String Public errFile As String Public Function loopFiles(ByVal sFolder As String, ByVal noI As Integer) 'This function will loop through all files in the selected folder 'to make sure that they are all of excel type Dim FOLDER, files, file, FSO As Object excelI = noI 'MsgBox excelI i = 0 'Dim writeFile As Object 'writeFile = My.Computer.FileSystem.WriteAllText("D:\Test\test.txt", "sdgdfgds", False) Dim cnn As Connection Set cnn = New ADODB.Connection currApp = ActiveWorkbook.path errFile = currApp & "\errorFile.txt" If emptyFile.FileExists(errFile) Then Kill errFile Else 'Do Nothing End If 'cnn.Open "DSN=AUTOLIV" 'cnn.Open "D:\Work\Projects\Autoliv\Tax workshop\Tax Schedules\sox_questionnaire.mdb" cnn.Open ("DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & currApp & "\tax_questionnaire.mdb") With Application .Calculation = xlCalculationManual .ScreenUpdating = False End With Set FSO = CreateObject("Scripting.FileSystemObject") 'Upon each found excel file it will make a call to saveFiles. If sFolder <> "" Then Set FOLDER = FSO.getfolder(sFolder) Set files = FOLDER.files For Each file In files 'ONLY WORK WITH EXCEL FILES If file.Type = "Microsoft Excel Worksheet" Then Workbooks.Open fileName:=file.path xlsx是一个“无macros”的工作簿。 要以新的文件格式使用VBA，文件必须保存为xlsm文件。
编辑：我太匆忙地读了这个问题。 如果要从FSO对象中识别excel文件，请使用file.Type LIKE "Microsoft Excel *"或类似方法。 或者，检查文件的扩展名为“.xls *”
编辑
通过查看文件名识别文件types的整个概念是根本上有缺陷的。 通过更改文件扩展名和/或与这些描述相关联的“types”文本，这太容易被破坏。 很容易被名为“file.xls”的图像文件破坏。 我只是试着用Workbook打开文件。打开并捕获错误。 我可能把这个逻辑放在一个单独的函数中：
Function OpenWorkbook(strPath As String) As Workbook On Error GoTo ErrorLabel Set OpenWorkbook = Workbooks.Open(strPath) ExitLabel: Exit Function ErrorLabel: If Err.Number = 1004 Then Resume ExitLabel Else 'other error handling code here Resume ExitLabel End If End Function
那么你可以使用这样的function：
Dim w As Workbook Set w = OpenWorkbook(file.Path) If Not (w Is Nothing) Then '...
你遇到的问题与这一行有关：
If file.Type = "Microsoft Excel Worksheet" Then
尝试添加和replace它：
// add these lines just AFTER the line 'For Each file In files' IsXLFile = False FilePath = file.path FilePath2 = Right(FilePath, 5) FilePath3 = Mid(FilePath2, InStr(1, FilePath2, ".") + 1) If UCase(Left(FilePath3, 2)) = "XL" Then IsXLFile = True // replace faulty line with this line If IsXLFile = True Then
让我知道它是如何工作的。 是的，可以将以FilePath开头的语句压缩到一个expression式中，但为了清晰起见，我将其保留。 投票并接受答案，如果没有问题，则采取后续行动。
祝你今天愉快。