我创建一个简单的报告excel,当用户选择文件夹时,它会合并xls文件。它完美地工作,直到我在不同的PC上测试,我得到了#34;在隐藏模块中编译错误"错误。以下是错误的屏幕截图。
以下是我从互联网上获得的MergeSheets模块代码。
Option Explicit
Public strPath As String
Public Type SELECTINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As SELECTINFO) As Long
Function SelectFolder(Optional Msg) As String
Dim sInfo As SELECTINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
sInfo.pidlRoot = 0&
If IsMissing(Msg) Then
sInfo.lpszTitle = "Select your folder."
Else
sInfo.lpszTitle = Msg
End If
sInfo.ulFlags = &H1
x = SHBrowseForFolder(sInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
SelectFolder = Left(path, pos - 1)
Else
SelectFolder = ""
End If
End Function
"Merging Part"
Sub MergeExcels()
Dim path As String, ThisWB As String, lngFilecounter As Long
Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
Dim Filename As String, Wkb As Workbook
Dim CopyRng As Range, Dest As Range
Dim RowofCopySheet As Integer
RowofCopySheet = 1
ThisWB = ActiveWorkbook.Name
path = SelectFolder("Select a folder containing Excel files you want to merge")
Application.EnableEvents = False
Application.ScreenUpdating = False
Set shtDest = ActiveWorkbook.Sheets(1)
Filename = Dir(path & "\*.xls", vbNormal)
If Len(Filename) = 0 Then Exit Sub
Do Until Filename = vbNullString
If Not Filename = ThisWB Then
Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
CopyRng.Copy Dest
Wkb.Close False
End If
Filename = Dir()
Loop
Range("A1").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Files Merged!"
End Sub
我找到了问题的根源,即32位和64位操作系统的不兼容性。我设法找到了解决方案,我需要将PtrSafe包含在我的声明部分中。在我加入" PtrSafe"如下所示,错误不再出现。
Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As SELECTINFO) As Long
然而,当我执行代码时,我的Excel程序崩溃了。
虽然这个代码是为32位操作系统创建的,但是当我在64位版本的PC上进行开发时它正在运行。我甚至在第二台PC上尝试了相同的代码,也就是64位。然而,当我尝试第三台也是64位的PC时,错误出现了。
希望你能给出这个想法。感谢。