★★★備忘録の作成：リンク先のPDFやdocx、zipなどの一括ダウンロードやリネームなど

　　
※まだ書きかけです。すみません。
※間違ってたらすみません。
※メモ書きなので、自分でも意味不明な箇所も多いです。ごめんなさい。
　　
　　
※関連記事
『ファイル名検索で「★、-、●、～、(、)、」などの記号がヒットしないときの対処法』
　　
★ 解説サイトのPDFやdocx、Zipなどを一括ダウンロードするソフト
ウィルスが一応無さそうで、初心者でも使えそうなものとして「いもづるダウンローダー」がひとつの選択肢として挙げられます。
https://www.vector.co.jp/soft/dl/winnt/net/se477947.html

インストールが完了したら、「設定→詳細設定」にて、「拡張子設定」で、
「jpg, mpg, wmv, flv, mp3, wma 」に加えて、
「 , pdf, docx, docm ,doc, xls, xlsx ,xlsm, zip, lzh 」も追加します。
OKして設定完了です。

あとは特別設定はいらないと思います。
リンクの書いてあるWebページとダウンロード先のフォルダを指定して、一括ダウンロードするだけです。
　　
　　
＝＝＝＝＝＝＝＝＝＝＝＝＝
　　
　　
★ リネーム01
ContextReplace
https://www.gigafree.net/utility/rename/ContextReplace.html

　　
　　
＝＝＝＝＝＝＝＝＝＝＝＝＝
　　
　　

★ リネーム02
ExcelVBAの使用

▼ Module1_下処理

　＝「ContextReplace」でやるような処理。

一応「すべての」サブフォルダも対象です。
特定の文字列を消す処理。
処理するファイルのフルパスを「Sheet6」という名前のシートに書き出すため、事前に「Sheet6」シートの作成が必要です。
（「Sheet6」を作らないならその部分のコードを書き換えます。）

s_FoldPath = "リネーム対象のフォルダのパス"
の行と
s_FName01 = Replace(s_FName01, "www.×××.net%2F×××%2F", "", , , vbBinaryCompare)
s_FName01 = Replace(s_FName01, "www.×××.net%2F××××%2F", "", , , vbBinaryCompare)
s_FName01 = Replace(s_FName01, "www.×××.net%2F×××××%2F", "", , , vbBinaryCompare)
の行の内容を
現況と合うように書き換えます。
※また、「Microsoft Spripting Runtime」への参照設定が必要です。

'
'
Option Explicit

'#########################################################################
'「いもづるダウンローダー」にてのダウンロード直後のファイル名から、
'「www.×××.net%2F×××%2F」などを取る作業
'#########################################################################

Sub getFolderAndFileListMain01_n_Rename01()
'https://xxxx7.com/2016/06/06/100040 を加工
 
    Dim o_AnswFDialg As FileDialog
    Dim s_FoldPath   As String
    Dim o_WS01   As Worksheet
    
    
    '★ 設定部
      
'    Set o_AnswFDialg = Application.FileDialog(msoFileDialogFolderPicker)
    s_FoldPath = "リネーム対象のフォルダのパス"
    Set o_WS01 = ThisWorkbook.Worksheets("sheet6")
    
    '★ 実動部
    o_WS01.Cells.ClearContents
    
'    'ファイル選択ダイアログを開き、
'    'フォルダパスを得られたら次へ行き、キャンセルされたらプログラムを終わる。
'    If Not o_AnswFDialg.Show Then Exit Sub
        
    'リスト作成の実行。
'    Call getFolderAndFileListSub(folderPath:=o_AnswFDialg.SelectedItems(1))
    Call getFolderAndFileListSub_n_Rename02(folderPath:=s_FoldPath)
    
    
    o_WS01.Activate
    o_WS01.Range("A1").Activate
    MsgBox "完了しました！"

    
End Sub
 
'https://xxxx7.com/2016/06/06/100040 を加工
 
Sub getFolderAndFileListSub_n_Rename02(folderPath As String, _
                                      Optional myCount As Long = 0)
 
    
    '※「Microsoft Spripting Runtime」 への参照設定が必要。
    
    Dim fso As New FileSystemObject
    Dim myFolder As Folder
    Dim myFile As File
    
    Dim s_ChkWord01 As String
    Dim s_FName01 As String
    Dim s_Kakutyousi As String
 
'    myCount = 1
'    '列名分を考慮にいれる（処理対象からはずす）
    
    'そのフォルダの中「だけ」の、ファイル一覧の書き出し。
    For Each myFile In fso.GetFolder(folderPath).Files
    
        myCount = myCount + 1
        Worksheets("sheet6").Cells(myCount, 1) = myFile.Path
        
        s_FName01 = myFile.Name
        Worksheets("sheet6").Cells(myCount, 2) = s_FName01
'        Cells(myCount, 2) = CStr(Left(myFile.Name, 3))

            
            On Error Resume Next
            '同じファイル名が既にあるとエラーになるので無視してスルーする。
                        
            
            '「いもづるダウンローダー」にてのダウンロード直後のファイル名から、
            '「www.×××.net%2F×××%2F」などを取る作業
            s_FName01 = Replace(s_FName01, "www.×××.net%2F×××%2F", "", , , vbBinaryCompare)
            s_FName01 = Replace(s_FName01, "www.×××.net%2F××××%2F", "", , , vbBinaryCompare)
            s_FName01 = Replace(s_FName01, "www.×××.net%2F×××××%2F", "", , , vbBinaryCompare)
            
            
            
            '著者ご本人様の ファイル名前作成ミスの修正
            If s_FName01 = "0981.pdf" Then
                s_FName01 = "098.pdf"
            Else
            
            End If
            
            
            myFile.Name = s_FName01
            'リネーム実行。
            
            
            s_FName01 = ""
            '一応初期化

    Next
        
    
    'サブフォルダを再帰的に覗いていくだけの処理。
    'この処理を「フォルダの中のファイル一覧の書き出し。」よりも先にやると、
    'フォルダ構造としては深い階層からの逆順になる
    '（ファイルの並びは昇順だけれども）
    For Each myFolder In fso.GetFolder(folderPath).SubFolders
    
        Call getFolderAndFileListSub_n_Rename02(myFolder.Path, myCount)
        
    Next
    
   
 
End Sub

'
'

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

Option Explicit

'#########################################################################

'「いもづるダウンローダー」にてのダウンロード直後のファイル名から、

'「www.×××.net%2F×××%2F」などを取る作業

'#########################################################################

Sub getFolderAndFileListMain01_n_Rename01()

'https://xxxx7.com/2016/06/06/100040 を加工

Dim o_AnswFDialg As FileDialog

Dim s_FoldPath As String

Dim o_WS01 As Worksheet

'★ 設定部

' Set o_AnswFDialg = Application.FileDialog(msoFileDialogFolderPicker)

s_FoldPath = "リネーム対象のフォルダのパス"

Set o_WS01 = ThisWorkbook.Worksheets("sheet6")

'★ 実動部

o_WS01.Cells.ClearContents

' 'ファイル選択ダイアログを開き、

' 'フォルダパスを得られたら次へ行き、キャンセルされたらプログラムを終わる。

' If Not o_AnswFDialg.Show Then Exit Sub

'リスト作成の実行。

' Call getFolderAndFileListSub(folderPath:=o_AnswFDialg.SelectedItems(1))

Call getFolderAndFileListSub_n_Rename02(folderPath:=s_FoldPath)

o_WS01.Activate

o_WS01.Range("A1").Activate

MsgBox "完了しました！"

End Sub

'https://xxxx7.com/2016/06/06/100040 を加工

Sub getFolderAndFileListSub_n_Rename02(folderPath As String, _

Optional myCount As Long = 0)

'※「Microsoft Spripting Runtime」への参照設定が必要。

Dim fso As New FileSystemObject

Dim myFolder As Folder

Dim myFile As File

Dim s_ChkWord01 As String

Dim s_FName01 As String

Dim s_Kakutyousi As String

' myCount = 1

' '列名分を考慮にいれる（処理対象からはずす）

'そのフォルダの中「だけ」の、ファイル一覧の書き出し。

For Each myFile In fso.GetFolder(folderPath).Files

myCount = myCount + 1

Worksheets("sheet6").Cells(myCount, 1) = myFile.Path

s_FName01 = myFile.Name

Worksheets("sheet6").Cells(myCount, 2) = s_FName01

' Cells(myCount, 2) = CStr(Left(myFile.Name, 3))

On Error Resume Next

'同じファイル名が既にあるとエラーになるので無視してスルーする。

'「いもづるダウンローダー」にてのダウンロード直後のファイル名から、

'「www.×××.net%2F×××%2F」などを取る作業

s_FName01 = Replace(s_FName01, "www.×××.net%2F×××%2F", "", , , vbBinaryCompare)

s_FName01 = Replace(s_FName01, "www.×××.net%2F××××%2F", "", , , vbBinaryCompare)

s_FName01 = Replace(s_FName01, "www.×××.net%2F×××××%2F", "", , , vbBinaryCompare)

'著者ご本人様のファイル名前作成ミスの修正

If s_FName01 = "0981.pdf" Then

s_FName01 = "098.pdf"

Else

End If

myFile.Name = s_FName01

'リネーム実行。

s_FName01 = ""

'一応初期化

'サブフォルダを再帰的に覗いていくだけの処理。

'この処理を「フォルダの中のファイル一覧の書き出し。」よりも先にやると、

'フォルダ構造としては深い階層からの逆順になる

'（ファイルの並びは昇順だけれども）

For Each myFolder In fso.GetFolder(folderPath).SubFolders

Call getFolderAndFileListSub_n_Rename02(myFolder.Path, myCount)

End Sub

　　
　　
▼ Module2_本番

より具体的な本番のリネームです。
Sheet5という名前のシートが必要です。あるいは、その部分を書き換えます。

※「Microsoft Spripting Runtime」への参照設定が必要です。

'
'
Option Explicit

'#########################################################################
'「www.×××.net%2F×××%2F」などを取ったあとに、
' Sheet1の「列名02」での名前にリネームする作業
'#########################################################################

Sub getFolderAndFileListMain02_n_Rename01()
'https://xxxx7.com/2016/06/06/100040 を加工
 
    Dim o_AnswFDialg As FileDialog
    Dim s_FoldPath   As String
    Dim o_WS02   As Worksheet
    
    '★ 設定部
      
'    Set o_AnswFDialg = Application.FileDialog(msoFileDialogFolderPicker)
    s_FoldPath = "リネーム対象のフォルダのパス"
    Set o_WS02 = ThisWorkbook.Worksheets("sheet5")
    
    '★ 実動部
    o_WS02.Cells.ClearContents
    
'    'ファイル選択ダイアログを開き、
'    'フォルダパスを得られたら次へ行き、キャンセルされたらプログラムを終わる。
'    If Not o_AnswFDialg.Show Then Exit Sub
        
    'リスト作成の実行。
'    Call getFolderAndFileListSub(folderPath:=o_AnswFDialg.SelectedItems(1))
    Call getFolderAndFileListSub_n_Rename(folderPath:=s_FoldPath)
    
    o_WS02.Activate
    o_WS02.Range("A1").Activate
    MsgBox "完了しました！"


End Sub
 
'https://xxxx7.com/2016/06/06/100040 を加工
 
Sub getFolderAndFileListSub_n_Rename(folderPath As String, _
                                      Optional myCount As Long = 0)
 
    
    '※「Microsoft Spripting Runtime」 への参照設定が必要。
    
    Dim fso As New FileSystemObject
    Dim myFolder As Folder
    Dim myFile As File
    
    Dim s_ChkWord01 As String
    Dim s_FName01 As String
    Dim s_Kakutyousi As String
 
'    myCount = 1
'    '列名分を考慮にいれる（処理対象からはずす）
    
    'そのフォルダの中「だけ」の、ファイル一覧の書き出し。
    For Each myFile In fso.GetFolder(folderPath).Files
    
        myCount = myCount + 1
        Worksheets("sheet5").Cells(myCount, 1) = myFile.Path
        Worksheets("sheet5").Cells(myCount, 2) = myFile.Name
'        Cells(myCount, 2) = CStr(Left(myFile.Name, 3))


        
        s_ChkWord01 = CStr(Left(myFile.Name, 3))
        '現在のファイル名の先頭の3文字をゲット。
        
        s_Kakutyousi = fso.GetExtensionName(myFile.Path)
        '拡張子のゲット。（ドット無し。）
        
        
        
        If s_ChkWord01 = Worksheets("Sheet1").Cells(myCount, 1).Value Then
        
            '「Sheet1」の「連番＿文字列」の値と、
            'ファイル名の先頭3文字が合致していたら
            '以下の処理。
            
            
            s_FName01 = Worksheets("Sheet1").Cells(myCount, 3).Value & "." & s_Kakutyousi
'            Worksheets("Sheet5").Cells(myCount, 2).Value = "OK"  'テスト用コード
            
            
            'ファイル名に使えない文字（記号）を別の文字に置換。
            s_FName01 = Replace(s_FName01, "/", "-", , , vbBinaryCompare)
            
            
            On Error Resume Next
            '同じファイル名が既にあるとエラーになるので無視してスルーする。
            
            
            myFile.Name = s_ChkWord01 & "_" & s_FName01
            'リネーム実行。
            
            
                        
            s_FName01 = ""
            '一応初期化
            
        Else
        
        End If
    Next
        
    
    'サブフォルダを再帰的に覗いていくだけの処理。
    'この処理を「フォルダの中のファイル一覧の書き出し。」よりも先にやると、
    'フォルダ構造としては深い階層からの逆順になる
    '（ファイルの並びは昇順だけれども）
    For Each myFolder In fso.GetFolder(folderPath).SubFolders
    
        Call getFolderAndFileListSub_n_Rename(myFolder.Path, myCount)
        
    Next
    
   
 
End Sub






'
'

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

Option Explicit

'#########################################################################

'「www.×××.net%2F×××%2F」などを取ったあとに、

' Sheet1の「列名02」での名前にリネームする作業

'#########################################################################

Sub getFolderAndFileListMain02_n_Rename01()

'https://xxxx7.com/2016/06/06/100040 を加工

Dim o_AnswFDialg As FileDialog

Dim s_FoldPath As String

Dim o_WS02 As Worksheet

'★ 設定部

' Set o_AnswFDialg = Application.FileDialog(msoFileDialogFolderPicker)

s_FoldPath = "リネーム対象のフォルダのパス"

Set o_WS02 = ThisWorkbook.Worksheets("sheet5")

'★ 実動部

o_WS02.Cells.ClearContents

' 'ファイル選択ダイアログを開き、

' 'フォルダパスを得られたら次へ行き、キャンセルされたらプログラムを終わる。

' If Not o_AnswFDialg.Show Then Exit Sub

'リスト作成の実行。

' Call getFolderAndFileListSub(folderPath:=o_AnswFDialg.SelectedItems(1))

Call getFolderAndFileListSub_n_Rename(folderPath:=s_FoldPath)

o_WS02.Activate

o_WS02.Range("A1").Activate

MsgBox "完了しました！"

End Sub

'https://xxxx7.com/2016/06/06/100040 を加工

Sub getFolderAndFileListSub_n_Rename(folderPath As String, _

Optional myCount As Long = 0)

'※「Microsoft Spripting Runtime」への参照設定が必要。

Dim fso As New FileSystemObject

Dim myFolder As Folder

Dim myFile As File

Dim s_ChkWord01 As String

Dim s_FName01 As String

Dim s_Kakutyousi As String

' myCount = 1

' '列名分を考慮にいれる（処理対象からはずす）

'そのフォルダの中「だけ」の、ファイル一覧の書き出し。

For Each myFile In fso.GetFolder(folderPath).Files

myCount = myCount + 1

Worksheets("sheet5").Cells(myCount, 1) = myFile.Path

Worksheets("sheet5").Cells(myCount, 2) = myFile.Name

' Cells(myCount, 2) = CStr(Left(myFile.Name, 3))

s_ChkWord01 = CStr(Left(myFile.Name, 3))

'現在のファイル名の先頭の3文字をゲット。

s_Kakutyousi = fso.GetExtensionName(myFile.Path)

'拡張子のゲット。（ドット無し。）

If s_ChkWord01 = Worksheets("Sheet1").Cells(myCount, 1).Value Then

'「Sheet1」の「連番＿文字列」の値と、

'ファイル名の先頭3文字が合致していたら

'以下の処理。

s_FName01 = Worksheets("Sheet1").Cells(myCount, 3).Value & "." & s_Kakutyousi

' Worksheets("Sheet5").Cells(myCount, 2).Value = "OK" 'テスト用コード

'ファイル名に使えない文字（記号）を別の文字に置換。

s_FName01 = Replace(s_FName01, "/", "-", , , vbBinaryCompare)

On Error Resume Next

'同じファイル名が既にあるとエラーになるので無視してスルーする。

myFile.Name = s_ChkWord01 & "_" & s_FName01

'リネーム実行。

s_FName01 = ""

'一応初期化

Else

End If

'サブフォルダを再帰的に覗いていくだけの処理。

'この処理を「フォルダの中のファイル一覧の書き出し。」よりも先にやると、

'フォルダ構造としては深い階層からの逆順になる

'（ファイルの並びは昇順だけれども）

For Each myFolder In fso.GetFolder(folderPath).SubFolders

Call getFolderAndFileListSub_n_Rename(myFolder.Path, myCount)

End Sub

投稿タグ: ExcelVBA, Excelの独学, PDF, ビジネスパソコンの基礎, フリーウェア, 備忘録作成, 独学, 自動化

MENU

関連記事

最近の投稿

カテゴリー

MENU

★★★備忘録の作成：リンク先のPDFやdocx、zipなどの一括ダウンロードやリネームなど

関連記事

最近の投稿

カテゴリー

タグ