基于WinHttpRequest利用用户AD凭据实现Excel展示SharePoint零件图片的需求

Hey there! Let's get that SharePoint image retrieval working with fallback logic in Excel VBA—here's a solid solution that uses your Active Directory credentials and handles missing images gracefully.

Solution Overview #

We'll build two core components:

• A helper function to check if a SharePoint image exists (leveraging your AD credentials for authentication)
• A main subroutine to loop through your part list, insert the SharePoint image if available, and fall back to your AwaitingImage.jpg placeholder when it's not

Full VBA Code #

Sub InsertPartImages()
    Dim ws As Worksheet
    Dim partID As String
    Dim spImageURL As String
    Dim fallbackImagePath As String
    Dim img As Shape
    Dim i As Long ' Properly declare loop variable
    
    ' --- Update these values to match your setup ---
    Set ws = ThisWorkbook.Worksheets("PartsList") ' Your target worksheet name
    fallbackImagePath = "C:\Your\Local\Path\AwaitingImage.jpg" ' Path to your placeholder image
    Const SharePointBaseURL As String = "https://your-sharepoint-site.com/sites/parts/Images/" ' Base URL for your part image library
    ' --- End of customizations ---
    
    ' Loop through rows (assuming Part IDs are in column A, starting at row 2)
    For i = 2 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        partID = Trim(ws.Cells(i, "A").Value)
        If partID <> "" Then
            spImageURL = SharePointBaseURL & partID & ".jpg" ' Build full image URL
            
            ' Check if the SharePoint image exists
            If SharePointFileExists(spImageURL) Then
                ' Insert the SharePoint image into column B
                Set img = ws.Shapes.AddPicture( _
                    Filename:=spImageURL, _
                    LinkToFile:=msoFalse, _
                    SaveWithDocument:=msoTrue, _
                    Left:=ws.Cells(i, "B").Left, _
                    Top:=ws.Cells(i, "B").Top, _
                    Width:=100, ' Adjust image width as needed
                    Height:=100) ' Adjust image height as needed
            Else
                ' Insert the fallback placeholder image
                Set img = ws.Shapes.AddPicture( _
                    Filename:=fallbackImagePath, _
                    LinkToFile:=msoFalse, _
                    SaveWithDocument:=msoTrue, _
                    Left:=ws.Cells(i, "B").Left, _
                    Top:=ws.Cells(i, "B").Top, _
                    Width:=100, _
                    Height:=100)
            End If
            
            ' Optional: Format image to fit neatly in the cell
            img.LockAspectRatio = msoTrue ' Preserve image proportions
            img.Top = ws.Cells(i, "B").Top
            img.Left = ws.Cells(i, "B").Left
            img.Name = "PartImg_" & partID ' Name the shape for easy future reference
        End If
    Next i
End Sub

Function SharePointFileExists(fileURL As String) As Boolean
    Dim xmlHttp As Object
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
    
    On Error Resume Next
    ' Use current user's AD credentials (empty username/password triggers Windows auth)
    xmlHttp.Open "HEAD", fileURL, False, "", ""
    xmlHttp.send
    
    ' Check if the server returned a valid status (200 = exists, 304 = exists but not modified)
    SharePointFileExists = (xmlHttp.Status = 200 Or xmlHttp.Status = 304)
    On Error GoTo 0 ' Reset error handling
    
    Set xmlHttp = Nothing
End Function

Key Details & Adjustments #

1. Authentication: The MSXML2.XMLHTTP.6.0 object automatically uses your logged-in AD credentials when we pass empty strings for username/password. This works seamlessly for SharePoint sites using Windows Integrated Authentication.
2. Efficient Existence Check: We use a HEAD request instead of a full GET—it's faster because it only retrieves the server's status code, not the entire image file.
3. Image Embedding: Setting SaveWithDocument:=msoTrue embeds images directly into Excel, so your sheet won't break if you're offline or the SharePoint link changes later.
4. Must-Update Values: Don't forget to tweak these to match your environment:
   • The target worksheet name (PartsList)
   • The local path to your AwaitingImage.jpg
   • The SharePoint base URL pointing to your image library

Notes to Keep in Mind #

• If you get an error about MSXML2.XMLHTTP.6.0, open the VBA editor > Tools > References, and check "Microsoft XML, v6.0" (it's usually enabled by default, but better to confirm).
• If your SharePoint site uses modern authentication (not AD), you'll need to adjust the auth logic—but since you specified AD credentials, this code should work out of the box.
• Adjust the Width and Height values to match how you want images to display in your cells.

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