はじめに
こんな感じで作ってみた
ソースコード
' Windows API定義
#If Win64 Then
' Office 64bitアプリケーション用
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileW" ( _
ByVal pCaller As Long, _
ByVal szURL As Long, _
ByVal szFileName As Long, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "wininet" Alias "DeleteUrlCacheEntryW" ( _
ByVal lpszUrlName As Long) As Long
Private Declare PtrSafe Sub Sleep Lib "kernel32" ( _
ByVal dwMilliseconds As Long)
#Else
' Office 32bitアプリケーション用
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileW" ( _
ByVal pCaller As Long, _
ByVal szURL As Long, _
ByVal szFileName As Long, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long
Private Declare Function DeleteUrlCacheEntry Lib "wininet" Alias "DeleteUrlCacheEntryW" ( _
ByVal lpszUrlName As Long) As Long
Private Declare Sub Sleep Lib "kernel32" ( _
ByVal dwMilliseconds As Long)
#End If
Sub ファイルダウンロード_Click()
Dim result As Long '実行結果
Dim strSaveDir As String 'ダウンロードディレクトリ
Dim strSaveFile As String 'ダウンロードファイル
Dim ws As Worksheet
strSaveDir = ThisWorkbook.Path & "\downloadFiles" & Application.PathSeparator
' フォルダがなければ作成する
If Dir(strSaveDir, vbDirectory) = "" Then
MkDir strSaveDir
Else
FilesExist = Dir(strSaveDir & "*")
If FilesExist = "" Then
' MsgBox "フォルダにファイルがありません。"
Else
Kill strSaveDir & "*"
End If
End If
'シート名
Set ws = Sheets("Sheet1")
'最終行
LastRow = ws.Range("C" & Rows.Count).End(xlUp).Row
For I = 3 To LastRow '3行目からダウンロード
ws.Range("B1").Value = (I - 2) & "/" & (LastRow - 2) & "ダウンロード中..." 'ダウンロード状況
result = 0
strSaveFile = strSaveDir & ws.Range("D" & I).Value
Do
' 5秒待機してからファイルをダウンロード(失敗時リトライするため＆連続ダウンロードは失敗した実績有)
Call Sleep(5000)
' キャッシュクリア
DeleteUrlCacheEntry (StrPtr(ws.Range("C" & I).Value))
' ファイルダウンロード
result = URLDownloadToFile(0, StrPtr(ws.Range("C" & I).Value), StrPtr(strSaveFile), 0, 0)
Loop While result <> 0
' 実行結果記載
If FileLen(strSaveFile) > 0 Then
ws.Range("E" & I).Value = "成功"
Else
ws.Range("E" & I).Value = "失敗(ファイルサイズが0)"
End If
Next I
ws.Range("B1").Value = ""
MsgBox "ダウンロードが完了しました！！" & vbCrLf & "下記フォルダをzip圧縮して配布願います。" & vbCrLf & strSaveDir
End Sub
セル設定
D列(URL→ダウンロードファイル名抽出)
=RIGHT(SUBSTITUTE(C4,"/"," ",LEN(C4)-LEN(SUBSTITUTE(C4,"/",""))),LEN(SUBSTITUTE(C4,"/"," ",LEN(C4)-LEN(SUBSTITUTE(C4,"/",""))))-FIND(" ",SUBSTITUTE(C4,"/"," ",LEN(C4)-LEN(SUBSTITUTE(C4,"/","")))))
B列(パッケージ名抽出→"-"分割で先頭を抽出)
="Selenium依存関係パッケージ(" & LEFT(D5,FIND("-",D5)-1) & ")"
F列(ライセンス情報)
※pip-licenseのパッケージをインストールして、【pip-licenses】コマンド実行
もしくは、pip show [パッケージ名]
ダウンロード情報
参考サイト
◆ExcelVBAでファイルをダウンロードする方法
https://errormaker.blog.fc2.com/blog-entry-66.html
◆VBAからUnicode版のWindows API を使う
https://codezine.jp/article/detail/1718
◆VBAで指定URLからファイルをダウンロード
http://www.it-view.net/vba%E3%81%A7%E6%8C%87%E5%AE%9Aurl%E3%81%8B%E3%82%89%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB%E3%82%92%E3%83%80%E3%82%A6%E3%83%B3%E3%83%AD%E3%83%BC%E3%83%89-364.html
◆VBAでインターネット上のファイルをダウンロードする方法をまとめてみました。
https://www.ka-net.org/blog/?p=4855
◆（Excel）URLからファイル名を取得する
https://www.officeisyours.com/entry/2020/11/09/011542
◆URLからファイル名を取得（一番右の指定文字以降を抽出）解答
https://excel-ubara.com/excel-answer/EXCEL706A.html
◆【VBA】ファイル/フォルダをZIP形式で圧縮する
https://excel-vba.work/2021/12/10/%E3%80%90vba%E3%80%91%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB-%E3%83%95%E3%82%A9%E3%83%AB%E3%83%80%E3%82%92zip%E5%BD%A2%E5%BC%8F%E3%81%A7%E5%9C%A7%E7%B8%AE%E3%81%99%E3%82%8B/
◆VBAでZIP圧縮と解凍を行う
https://vbabeginner.net/zip-comp-decomp/
◆保存先フォルダが存在しない場合はフォルダを作成してブックを保存する
https://www.moug.net/tech/exvba/0060035.html
◆VBA共通:Access、ExcelのVBAでWindowsの環境変数を取得するサンプルプログラム
https://selifelog.com/blog-entry-52.html