请懂行的帮忙看一下在64位Excel里的VB错误问题
懂行的帮忙看一下以下代码在32位Excel下运行没问题,在64位Excel下运行弹出对话框显示错误说是第一行的function需要用ptrsafe标记,请问该如何改,请指教。Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal DirPath As String) As Long[/color]
Function AddPath(Path As String) '批量创建文件夹
MakeSureDirectoryPathExists (Path)
End Function
Function QueryFile(File, Ftype) '遍历文件夹下的指定格式文件 函数(路径,文件类型)数组
Dim MyName, Dic, Did, i, MyFileName
Set Dic = CreateObject("Scripting.Dictionary") '创建一个字典对象
Set Did = CreateObject("Scripting.Dictionary")
Dic.Add (File), ""
i = 0
Do While i < Dic.Count
Ke = Dic.keys '开始遍历字典
MyName = Dir(Ke(i), vbDirectory) '查找目录
Do While MyName <> ""
If MyName <> "." And MyName <> ".." Then
If (GetAttr(Ke(i) & MyName) And vbDirectory) = vbDirectory Then '如果是次级目录
Dic.Add (Ke(i) & MyName & "\"), "" '就往字典中添加这个次级目录名作为一个条目
End If
End If
MyName = Dir '继续遍历寻找
Loop
i = i + 1
Loop
For Each Ke In Dic.keys '文件清单
MyFileName = Dir(Ke & "*." & Ftype)
Do While MyFileName <> ""
Did.Add (Ke & MyFileName), ""
MyFileName = Dir
Loop
Next
QueryFile = WorksheetFunction.Transpose(Did.keys)
End Function
Function SaveAs(Path As String) '另存为
ActiveWorkbook.SaveAs Filename:=Path, FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
End Function