使用Len（Dir檢查圖片文件並將其插入到excel文件中 - 只是不工作

Question

已嘗試寫入VBA以將圖片插入Excel中的特定列（F） 圖片文件的鏈接列在C列中 我研究了所有我可以聯機的，似乎找到了一種方式，它可以工作，但有一件事情一直在失敗！ 如果文件是有作品的話，如果C列中的單元格保留空白，它會將相應的單元格留在列F空白，但如果鏈接包含文件名不存在，則停止。 如果文件名已損壞=已聲明但不存在，我希望它只留下單元格空白並移至下一個單元格。可以看到我做錯了什麼？

Appriciate的幫助。 中號

Sub Insertpicture() 

Dim myPict As Picture 
Dim curWks As Worksheet 
Dim myRng As Range 
Dim myCell As Range 


Set curWks = Sheets(1) 
curWks.Pictures.Delete 

With curWks 
    Set myRng = .Range("c2", .Cells(.Rows.Count, "c").End(xlUp)) 
End With 

For Each myCell In myRng.Cells 
    If Trim(myCell.Value) = "" Then 
     ‘do nothing, move on 
    ElseIf Len(Dir(myCell.Value)) = 0 Then 
     ’here I want to leave the cell empty and just move on to check next cell 

    Else 
     With myCell.Offset(0, 3) 
      Set myPict = myCell.Parent.Pictures.Insert(myCell.Value) 
      myPict.Top = .Top 
      myPict.Width = .Width 
      myPict.Height = .Height 
      myPict.Left = .Left 
      myPict.Placement = xlMoveAndSize 
     End With 
    End If 

    Next myCell 

End Sub 

Answer 1

如果單元格是空的，Dir(myCell.Value)將是同樣的事情Dir(vbNullString)，它會從你的最後Dir命令返回的下一個結果。由於Dir以這種方式保持狀態，因此它不是確定文件（或缺少文件）是否存在的理想方式。我會用Scripting.FileSystemObject代替：

'Add a reference to Microsoft Scripting Runtime 
Sub Insertpicture() 

    Dim myPict As Picture 
    Dim curWks As Worksheet 
    Dim myRng As Range 
    Dim myCell As Range 

    Set curWks = Sheets(1) 
    With curWks 
     .Pictures.Delete 
     Set myRng = .Range("c2", .Cells(.Rows.Count, "c").End(xlUp)) 
    End With 

    With New Scripting.FileSystemObject 
     For Each myCell In myRng.Cells 
      If IsError(myCell.Value) Then 
       'do nothing, move on 
      ElseIf Not .FileExists(myCell.Value) Then 
       'leave the cell empty 
       myCell.Value = vbNullString 
      Else 
       With myCell.Offset(0, 3) 
        'You need to test to see if it's an image file here. 
        Set myPict = myCell.Parent.Pictures.Insert(myCell.Value) 
        myPict.Top = .Top 
        myPict.Width = .Width 
        myPict.Height = .Height 
        myPict.Left = .Left 
        myPict.Placement = xlMoveAndSize 
       End With 
      End If 
     Next myCell 
    End With 
End Sub 

請注意，您還需要測試細胞中的錯誤，你使用的值之前，你也應該要麼添加錯誤處理或測試，看看你是否找到該文件是一個有效的圖像文件。