Приведенный ниже код выдает Runtime Error: 13 Type mismatch
. У меня есть список тысяч URL-адресов в Sheet3, column A
, где я запускаю свой сценарий vba. Он находит каждый из URL-адресов в Sites, column B
из 300 книг, находящихся в папке. Если найдено, column E
той же строки обновляется на Yes
.
Sub ReplaceInFolder()
Dim strPath As String
Dim strFile As String
Dim wbk As Workbook
Dim wsh As Worksheet
Dim strReplace As String
Dim i As Long
Dim FoundCell As Variant
Dim FoundNo As String
strReplace = "Yes"
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then
strPath = .SelectedItems(1)
Else
MsgBox "No folder selected!", vbExclamation
Exit Sub
End If
End With
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
Application.ScreenUpdating = False
strFile = Dir(strPath & "*.xls*")
Do While strFile <> ""
Set wbk = Workbooks.Open(Filename:=strPath & strFile, AddToMRU:=False)
For Each wsh In wbk.Worksheets
If wsh.Name = "Sites" Then
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
Set FoundCell = wsh.Range("B:B").Find(What:=Cells(i, "A").Value, LookAt:=xlWhole, MatchCase:=False)
If Not FoundCell Is Nothing Then
FoundNo = FoundCell.Address
Debug.Print FoundCell.Address
Do Until FoundCell Is Nothing
wsh.Cells(FoundCell.Row, 5).Value = strReplace
Set FoundCell = wsh.Cells.FindNext(after:=FoundCell)
If FoundCell.Address = FoundNo Then Exit Do
Loop
End If
Next i
End If
Next wsh
wbk.Close SaveChanges:=True
strFile = Dir
Loop
Application.ScreenUpdating = True
End Sub