【VBA】画像スクレイピングについて

Question

エクセル内にある画像URLをスクレイピングして、指定するフォルダに保存するVBAを作成したつもりでしたが、何度やってもfilenameにてエラーが発生します。
その他にもエラー箇所がありましたら、ご教授いただけますでしょうか。
また、以下コードにファイル名をL列に並んだB列のものに出来るようにしたいです。
※office365　64ビットとなります。
何卒よろしくお願いいたします。

Option Explicit
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As LongPtr, ByVal szURL As String, ByVal _
szFileName As String, ByVal dwReserved As LongPtr, ByVal lpfnCB As LongPtr) As LongPtr

'簡略化【案】
Sub downloadimages()
Dim lastrow As Long
Dim rc As Long
On Error Resume Next
Dim downloadStatus As Variant
Dim url As String
Dim destinationFile_local As String
MkDir "C:\Users\Guest\Pictures"
lastrow = Sheet2.Range(Range("L2"), Range("L2").End(xlDown)).Count

For rc = "TK0804" To lastrow
url = Sheet2.Cells(rc, 1).Value
desttinationFile_local = "C:\Users\Guest\Pictures" & Filename(rc - 1 & ".jpg")
downloadStatus = URLDownloadToFile(0, url, desttinationFile_local, 0, 0)

Next
nsgBox "☆完了☆"
Call openFolder("C:\Users\Guest\Pictures")
End Sub
Sub openFolder(path As String)

Shell "C:\Windows\Explorer.exe " & path, vbNormalFocus

End Sub

Comments

[mashison.jr]

お忙しい中ありがとうございます。
ミスを含めて修正しましたが、実行時エラー53が出る状況でした。
お手数ですがご指摘頂けると幸いです。

Option Explicit
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As LongPtr, ByVal szURL As String, ByVal _
szFileName As String, ByVal dwReserved As LongPtr, ByVal lpfnCB As LongPtr) As LongPtr

'簡略化【案】
Sub downloadimages()
  Dim lastrow As Long
  Dim rc As Long
  Dim downloadStatus As Variant
  Dim url As String
  Dim desttinationFile_local As String
  MkDir "D:\test"
  lastrow = Sheet2.Range(Range("L2"), Range("L2").End(xlDown)).Count

 For rc = 1 To lastrow
    url = Sheet2.Cells(rc, 1).Value
    desttinationFile_local = "D:\test" & rc & ".jpg"
    downloadStatus = URLDownloadToFile(0, url, desttinationFile_local, 0, 0)

 Next
 MsgBox "完了"
 Call openFolder(D:\test)
End Sub
Sub openFolder(path As String)

 Shell "C:\Windows\explorer.exe" & path, vbNormalFocus

End Sub

[hatena19]

どの行でエラーが出ますか。
また、エラーメッセージは何でしょうか。

[hatena19]

とりあえず明らかな間違いは、

Call openFolder(D:\test)
↓
Call openFolder("D:\test")

Shell "C:\Windows\explorer.exe" & path, vbNormalFocus
↓
Shell "C:\Windows\explorer.exe " & path, vbNormalFocus

[mashison.jr]

お忙しい中、ご協力いただきありがとうございます、
あれから、いろいろと見直しをしまして、以下のようにコードを直したのですが、
未だにCall openFolder("D:\test")にてエラー35が出てわかりませんでした。

Option Explicit
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As LongPtr, ByVal szURL As String, ByVal _
szFileName As String, ByVal dwReserved As LongPtr, ByVal lpfnCB As LongPtr) As LongPtr

'簡略化【案】
Sub downloadimages()
Dim lastrow As Long
Dim rc As Long
Dim downloadStatus As Variant
Dim url As String
Dim desttinationFile_local As String

Dim Sheet2 As Worksheet
Set Sheet2 = Worksheets("Sheet2")

MkDir "D:\test"
lastrow = Sheet2.Range(Range("L2"), Range("L2").End(xlDown)).Count

For rc = 1 To lastrow
url = Sheet2.Cells(rc, 1).Value
desttinationFile_local = "D:\test" & Sheet2.Cells(rc, "A").Value & ".jpg"
downloadStatus = URLDownloadToFile(0, url, desttinationFile_local, 0, 0)
Next

MsgBox "完了"

Call openFolder("D:\test")
Shell "C:\Windows\explorer.exe" & path, vbNormalFocus

End Sub

[hatena19]

回答にコードを追記しましたのでそれを試してみてください。

[mashison.jr]

コードの修正等しましたが、エラー75が解決できず、苦戦しております。
可能性ある箇所はどちらになるのでしょうか？
パスがみつからないことについて、いろいろ調べていますが、検討つかない状況でした。

Answer 1

Filename(rc - 1 & ".jpg")としているということは、Filenameは自作関数ですよね。
まずは、そのコードも提示してください。

ただ、それ以前に、動作確認するときは、
On Error Resume Next
をコメントアウトしてから実行しましょう。
上記があるとエラーを無視してしまうので、原因の特定が難しくなります。

コメントアウトして実行すると For rc = "TK0804" To lastrowで型不一致エラーがでるはずです。
rc はLong型なので、"TK0804" の部分は数値でないとだめです。

他にも nsgBox "☆完了☆" もエラーになります。nsgBoxなどという関数はありません。

---

とりあえず下記のコードでどうですか。

Option Explicit
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As LongPtr, ByVal szURL As String, ByVal _
szFileName As String, ByVal dwReserved As LongPtr, ByVal lpfnCB As LongPtr) As LongPtr

'簡略化【案】
Sub downloadimages()
    Dim lastrow As Long
    Dim rc As Long
    Dim downloadStatus As Variant
    Dim url As String
    Dim desttinationFile_local As String

    Dim Sheet2 As Worksheet
    Set Sheet2 = Worksheets("Sheet2")

    MkDir "D:\test"
    lastrow = Sheet2.Range(Range("L2"), Range("L2").End(xlDown)).Count

    For rc = 1 To lastrow
        url = Sheet2.Cells(rc, 1).Value
        desttinationFile_local = "D:\test\" & Sheet2.Cells(rc, "A").Value & ".jpg"
        downloadStatus = URLDownloadToFile(0, url, desttinationFile_local, 0, 0)
    Next

    MsgBox "完了"

    Shell "C:\Windows\explorer.exe " & "D:\test", vbNormalFocus

End Sub

Answer 2

まずは、そのfilenameになにが入ってるのかチェックしてみよう。

Comments

[Zuishin]

関数に何が入るんですか？