【发布时间】:2017-08-19 04:05:35
【问题描述】:
这是我第一次使用 VBA,所以我需要帮助。这是 Excel 中的一个宏,用于将文件从一个 Excel 扩展名转换为另一个。我已经开始将此代码从 32 位转换为 64 位,并在网上找到了要更改的大多数关键部分,但现在它给了我编译错误:类型不匹配,我不知道要更改什么。任何帮助表示赞赏。
错误在 Sub loopConvert() 处显示黄色箭头,并将 cntToConvert 显示为蓝色突出显示的部分。包括图片。 Picture of Error
Option Explicit
'Created by David Miller (dlmille on E-E October, 2011)
'Feel free to use and share, please maintain appropriate acknowledgements the author and link where you found this code.
Sub loopConvert()
Dim fPath As String
Dim fName As String, fSaveAsFilePath As String, fOriginalFilePath As String
Dim wBook As Workbook, fFilesToProcess() As String
Dim numconverted As LongPtr, cntToConvert As LongPtr, i As LongPtr
Dim killOnSave As Boolean, xMsg As LongPtr, overWrite As Boolean, pOverWrite As Boolean
Dim silentMode As Boolean
Dim removeMacros As Boolean
Dim fromFormat As String, toformat As String
Dim saveFormat As LongPtr
Dim wkb As Workbook, wks As Worksheet
Set wkb = ThisWorkbook
Set wks = wkb.Sheets("Control Panel")
removeMacros = IIf(wks.CheckBoxes("Check Box 1").Value = 1, True, False)
silentMode = IIf(wks.CheckBoxes("Check Box 2").Value = 1, True, False)
killOnSave = IIf(wks.CheckBoxes("Check Box 3").Value = 1, True, False)
fromFormat = wkb.Names("fromFormat").RefersToRange
toformat = wkb.Names("toFormat").RefersToRange
saveFormat = IIf(toformat = ".XLS", xlExcel8, IIf(toformat = ".XLSX", xlOpenXMLWorkbook, xlOpenXMLWorkbookMacroEnabled))
Application.DisplayAlerts = False 'no user prompting, taking all defaults
Application.ScreenUpdating = False
fPath = GetFolderName("Select Folder for " & fromFormat & " to " & toformat & " conversion")
If fPath = "" Then
MsgBox "You didn't select a folder", vbCritical, "Aborting!"
Exit Sub
Else
fName = Dir(fPath & "\*" & fromFormat)
If fName = "" Then
MsgBox "There aren't any " & fromFormat & " files in the " & fPath & " directory", vbCritical, "Aborting"
Exit Sub
Else 'get a file count of files to be processed, then process them in the next step
Do
If UCase(Right(fName, Len(fromFormat))) = UCase(fromFormat) Then 'to differentiate between dir *.xls and inadvertently get *.xls???
ReDim Preserve fFilesToProcess(cntToConvert) As String
fFilesToProcess(cntToConvert) = fName
cntToConvert = cntToConvert + 1
End If
fName = Dir
Loop Until fName = ""
If cntToConvert = 0 Then 'we were looking for .XLS and there was only .XLS??? or nothing, then abort
MsgBox "There aren't any " & fromFormat & " files in the " & fPath & " directory", vbCritical, "Aborting"
Exit Sub
End If
If Not silentMode Then
xMsg = MsgBox("There are " & cntToConvert & " " & fromFormat & " files to convert to " & toformat & ". Do you want to delete the " & fromFormat & " files as they are processed?", vbYesNoCancel, "Select an Option")
killOnSave = False 'already false, but just a reminder this is in here!
If xMsg = vbYes Then
killOnSave = True
ElseIf xMsg = vbCancel Then
GoTo processComplete
End If
Else
pOverWrite = True
End If
Application.EnableEvents = False 'turn off events so macros don't fire on excel file opens
For i = 0 To cntToConvert - 1 'process each file for conversion, displaying status as progress...
Application.StatusBar = "Processing: " & i + 1 & " of " & cntToConvert & " file: " & fName
fName = fFilesToProcess(i)
'open and convert file
On Error GoTo errHandler
fOriginalFilePath = fPath & "\" & fName
'you could also check to see if the save as file already exists, before you open convert and save on top!
overWrite = False
fSaveAsFilePath = fPath & "\" & Mid(fName, 1, Len(fName) - Len(fromFormat)) & toformat
If Not pOverWrite Then
If FileFolderExists(fSaveAsFilePath) Then
xMsg = MsgBox("File: " & fSaveAsFilePath & " already exists, overwrite?", vbYesNoCancel, "Hit Yes to Overwrite, No to Skip, Cancel to quit")
If xMsg = vbYes Then
overWrite = True
ElseIf xMsg = vbCancel Then
GoTo processComplete
End If
Else
overWrite = True
End If
Else
overWrite = pOverWrite
End If
If overWrite Then
Set wBook = Application.Workbooks.Open(fOriginalFilePath)
If removeMacros And (toformat = ".XLS" Or toformat = ".XLSM") And (fromFormat <> ".XLSX") Then
'use Remove Macro Helper
Call RemoveAllMacros(wBook)
End If
wBook.SaveAs Filename:=fSaveAsFilePath, FileFormat:=saveFormat
wBook.Close savechanges:=False
numconverted = numconverted + 1
'optionally, you can delete the file you converted from
If killOnSave And fromFormat <> toformat Then
Kill fOriginalFilePath
End If
End If
Next i
End If
End If
processComplete:
On Error GoTo 0
MsgBox "Completed " & numconverted & " " & fromFormat & " to " & toformat & " conversions", vbOKOnly
Application.EnableEvents = True 'uncomment if doing other conversions where macros are involved in source workbooks
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = False
Exit Sub
errHandler:
Application.StatusBar = False
MsgBox "For some reason, could not open/save the file: " & fPath & "\" & fName, vbCritical, "Aborting!"
Resume processComplete
End Sub
【问题讨论】:
-
嗯,我认为你可以选择 Long 而不是 LongPtr。见stackoverflow.com/questions/24095500/…
-
感谢 Squidx3!我只需要在顶部进行更改。