注册 登录
编程论坛 VB6论坛

请懂行的帮忙看一下在64位Excel里的VB错误问题

szylnl 发布于 2013-06-02 09:20, 621 次点击
懂行的帮忙看一下以下代码在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
0 回复
1