Excel VBA需求：实现零件号搜索文件夹并生成PDF超链接（待完善）

一、实现零件PDF搜索并生成文件路径/超链接 #

以下代码会遍历指定主文件夹及所有子文件夹，匹配零件号对应的PDF文件，支持将文件路径写入C列（后续可手动转超链接），或直接生成可点击超链接：

Sub SearchPDFAndGenerateLink()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim partNum As String
    Dim searchPath As String
    Dim foundPath As String
    
    ' 设置工作表和搜索根路径
    Set ws = ThisWorkbook.Sheets("Sheet1")
    searchPath = "D:\YourMainFolder\" ' 替换为你的目标驱动器主文件夹路径
    
    ' 获取B列最后一行数据
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    
    ' 遍历B列零件号
    For i = 2 To lastRow
        partNum = ws.Cells(i, "B").Value
        If partNum <> "" Then
            ' 调用递归搜索函数找对应PDF
            foundPath = FindPDF(searchPath, partNum & ".pdf")
            
            If foundPath <> "" Then
                ' 选项1：写入文件路径到C列（后续可手动转超链接）
                ws.Cells(i, "C").Value = foundPath
                
                ' 选项2：直接生成可点击超链接（注释掉上面一行，打开下面一行）
                ' ws.Hyperlinks.Add Anchor:=ws.Cells(i, "C"), Address:=foundPath, TextToDisplay:=partNum & " PDF"
            Else
                ws.Cells(i, "C").Value = "未找到对应PDF"
            End If
        End If
    Next i
    
    MsgBox "搜索完成！", vbInformation
End Sub

' 递归搜索文件夹的函数
Function FindPDF(folderPath As String, fileName As String) As String
    Dim fso As Object
    Dim folder As Object, subFolder As Object
    Dim file As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(folderPath)
    
    ' 遍历当前文件夹文件
    For Each file In folder.Files
        If UCase(file.Name) = UCase(fileName) Then
            FindPDF = file.Path
            Exit Function
        End If
    Next file
    
    ' 递归遍历子文件夹
    For Each subFolder In folder.SubFolders
        FindPDF = FindPDF(subFolder.Path, fileName)
        If FindPDF <> "" Then Exit Function
    Next subFolder
    
    FindPDF = ""
End Function

代码说明： #

• 替换searchPath为你的目标主文件夹路径
• 两种输出方式二选一：写入纯路径，或直接生成超链接
• 函数FindPDF会递归遍历所有子文件夹，精确匹配文件名（不区分大小写）

二、解决Debug.Print内容保存到文本文件的语法错误 #

以下代码可将搜索结果（或自定义输出内容）保存到文本文件，避免常见语法错误：

Sub SaveDebugToText()
    Dim debugText As String
    Dim filePath As String
    Dim fileNum As Integer
    
    ' 设置保存路径（默认存于当前工作簿同目录）
    filePath = ThisWorkbook.Path & "\PDF_Search_Log.txt"
    
    ' 组装日志内容
    debugText = "PDF搜索日志：" & vbCrLf & vbCrLf
    
    ' 遍历Sheet1的零件号与结果，写入日志
    Dim ws As Worksheet, lastRow As Long, i As Long
    Set ws = ThisWorkbook.Sheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    
    For i = 2 To lastRow
        debugText = debugText & "零件号：" & ws.Cells(i, "B").Value & " -> " & ws.Cells(i, "C").Value & vbCrLf
    Next i
    
    ' 写入文本文件
    fileNum = FreeFile()
    Open filePath For Output As #fileNum
    Print #fileNum, debugText
    Close #fileNum
    
    MsgBox "日志已保存到：" & filePath, vbInformation
End Sub

常见语法错误原因及解决： #

• 未用FreeFile()获取合法文件号，导致文件占用冲突
• 文件路径含特殊字符或未正确拼接（用ThisWorkbook.Path可避免路径问题）
• 忘记关闭文件（必须执行Close #fileNum释放资源）

如果需要在搜索过程中实时输出日志，可直接在SearchPDFAndGenerateLink的循环中添加写入逻辑：

' 在SearchPDFAndGenerateLink的循环内添加：
fileNum = FreeFile()
Open filePath For Append As #fileNum
Print #fileNum, "零件号：" & partNum & " -> " & foundPath
Close #fileNum

内容的提问来源于stack exchange，提问作者Dillbert