PERSONAL.XLSB中VBA代码编译错误:用户定义类型未定义
问题:PERSONAL.XLSB中运行图片下载VBA代码报错“User-defined type not defined”
代码功能是从导出的Excel报表中提取图片URL并下载,在普通工作簿模块中运行正常,但移至PERSONAL.XLSB后无法运行,报错行:
Dim xmlhttp As New MSXML2.XMLHTTP60
错误提示:Compile error: User-defined type not defined
此前在普通工作簿中需启用Microsoft Scripting Runtime和Microsoft Office 16.0 Object Library引用才能运行,怀疑问题与PERSONAL.XLSB的引用配置有关。
完整代码
Option Explicit Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _ Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _ ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long Sub download_all_photos() Dim wk As Workbook Dim ws1 As Worksheet Dim counter As Integer Dim xmlhttp As New MSXML2.XMLHTTP60 Dim myURL As String, typ As String, name0 As String, name2 As String Dim catname As String Dim name1 As String, xstate As String, dlpath As String Dim pos As Integer Dim FileName As String Dim FileExists As String Dim xstatus As Long Dim i As Long Dim j As Long Dim lastRow_photos As Long Dim lastrow_Current As Integer Dim Sheet As Variant Dim CurrentRange As Range Dim purl As String Application.ScreenUpdating = False ' About to create a new "photo_url" sheet, delete any old one For Each Sheet In ActiveWorkbook.Worksheets If Sheet.Name = "photo_url" Then Application.DisplayAlerts = False Worksheets("photo_url").Delete Application.DisplayAlerts = True End If Next Sheet Sheets.Add.Name = "photo_url" lastrow_Current = Worksheets("Current").Cells(Rows.Count, 2).End(xlUp).Row j = 1 For i = 2 To lastrow_Current purl = Worksheets("Current").Cells(i, 19).Value If purl <> "" Then purl = Replace(purl, Chr(34), "") purl = Replace(purl, "<a target=_blank href=", "") purl = Replace(purl, ">Photo Link</a>", "") Worksheets("photo_url").Cells(j, 1).Value = purl Worksheets("photo_url").Cells(j, 2).Value = Worksheets("Current").Cells(i, 2).Value Worksheets("photo_url").Cells(j, 3).Value = Worksheets("Current").Cells(i, 3).Value Worksheets("photo_url").Cells(j, 4).Value = Replace(Worksheets("Current").Cells(i, 7).Value, "/ ", "_") j = j + 1 End If Next i Worksheets("photo_url").Columns("A:D").AutoFit lastRow_photos = Worksheets("photo_url").Cells(Rows.Count, 2).End(xlUp).Row dlpath = Worksheets("Instructions").Range("A1").Value counter = 0 For i = 1 To lastRow_photos myURL = Worksheets("photo_url").Range("A" & i).Value catname = Worksheets("photo_url").Range("C" & i).Value & "_" & Worksheets("photo_url").Range("B" & i).Value 'use if want to add shelterluv ID xmlhttp.Open "GET", myURL, False xmlhttp.send name0 = xmlhttp.getResponseHeader("Content-Disposition") If name0 <> "" Then pos = InStr(1, name0, "=") name2 = Mid(name0, pos + 1, (Len(name0) - (pos))) Else name2 = FileNameFromPath(myURL) End If FileName = dlpath & "\" & catname & ".png" FileExists = Dir(FileName) If FileExists = "" Then name2 = catname Else name2 = catname & Int(2 + Rnd * (100000 - 2 + 1)) ' add a random number to name End If Debug.Print myURL; FileName xstatus = URLDownloadToFile(0, myURL, FileName, 0, 0) Debug.Print xstatus Next i Application.ScreenUpdating = True End Sub Function FileNameFromPath(strFullPath As String) As String FileNameFromPath = Right(strFullPath, Len(strFullPath) - InStrRev(strFullPath, "/")) End Function
解决思路
1. 为PERSONAL.XLSB添加必要引用
PERSONAL.XLSB是独立的宏工作簿,普通工作簿的引用不会自动继承。需按以下步骤操作:
- 打开Excel,按
Alt+F11进入VBE - 在项目窗口找到
PERSONAL.XLSB,右键点击选择View Code - 点击菜单栏
Tools->References - 在弹出的对话框中,勾选以下选项:
- Microsoft XML, v6.0(对应
MSXML2.XMLHTTP60类型) - Microsoft Scripting Runtime
- Microsoft Office 16.0 Object Library
- Microsoft XML, v6.0(对应
- 点击
OK保存设置,重新运行宏
2. 使用后期绑定替代前期绑定(推荐)
后期绑定不需要依赖引用,兼容性更强,无需手动配置引用。修改代码中xmlhttp的声明部分:
- 将原声明:
替换为:Dim xmlhttp As New MSXML2.XMLHTTP60Dim xmlhttp As Object - 在使用
xmlhttp前添加初始化代码(推荐放在Application.ScreenUpdating = False之后):Set xmlhttp = CreateObject("MSXML2.XMLHTTP.6.0") - 注意:后期绑定会失去代码提示功能,但能避免引用依赖问题,适用于需要在不同工作簿或环境中运行的宏。
3. 检查PERSONAL.XLSB的信任设置
如果上述方法无效,可能是Excel信任中心限制了PERSONAL.XLSB的权限:
- 打开Excel,点击
File->Options->Trust Center->Trust Center Settings - 选择
Trusted Locations,确认PERSONAL.XLSB所在路径(通常是C:\Users\[你的用户名]\AppData\Roaming\Microsoft\Excel\XLSTART)已添加为受信任位置 - 选择
Macro Settings,设置为Enable all macros(或Disable all macros with notification,运行宏时选择启用)
内容的提问来源于stack exchange,提问作者BeckyW
相关产品推荐
相关产品推荐

