You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

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
  • 点击OK保存设置,重新运行宏

2. 使用后期绑定替代前期绑定(推荐)

后期绑定不需要依赖引用,兼容性更强,无需手动配置引用。修改代码中xmlhttp的声明部分:

  • 将原声明:
    Dim xmlhttp As New MSXML2.XMLHTTP60
    
    替换为:
    Dim 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

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.08.05 13:05:22