YouTubeにて、解説している講座動画の第4弾です！

VBAのコードを概要欄に掲載しようと思ったのですがどうやら角カッコ＜＞がHTMLのタグと認識されるのでコードが記載できないみたい。。

ということで、こちらのHPにてコード記載しておりますので、ぜひ見てみてください！

 

VBAコード

動画ではこちらのコードを利用しています。

'----------------------------------------------------
' 以下のプログラムで使うのだが、気にしなくてよい
Dim cnt As Long
Dim folderPathArray() As String
'----------------------------------------------------

'----------------------------------------------------
' フォルダ内のファイルを順に開いていくコード
'----------------------------------------------------
Sub フォルダ内のファイルを順に開く()
    
    Dim ws, 申請書ファイル As Workbook
    Set ws = ThisWorkbook.Worksheets("シート名")
    
    cnt = 0
    パスワード = ws.Range("A2").Value
    
    ' 親フォルダのフォルダパスを取得→配下の申請書ファイルを全部取得
    親フォルダパス = ws.Range("A1").Value
    Call GetFolder(親フォルダパス)

    ' 申請書ファイルを順に開く
    申請書数 = UBound(folderPathArray)
    For i = 1 To 申請書数
        
        申請書名 = folderPathArray(i)
        ' エクセルのパスワードがあれば、パスワードを解除しながら開く
        If パスワード <> "" Then
            Set 申請書ファイル = Workbooks.Open(申請書名, Password:=パスワード)
        Else
            Set 申請書ファイル = Workbooks.Open(申請書名)
        End If
        
        ' *************************************
        ' 書き込み処理
        ' ******************
        With 申請書ファイル.ActiveSheet
            ws.Range("A" & i + 5).Value = .Range("A1").Value
            ws.Range("B" & i + 5).Value = .Range("A2").Value
            ws.Range("C" & i + 5).Value = .Range("A3").Value
            ws.Range("D" & i + 5).Value = .Range("A4").Value
            ws.Range("E" & i + 5).Value = .Range("A5").Value
        End With
        ' *************************************
        申請書ファイル.Close
        
    Next
    
    MsgBox "完了しました"
    
End Sub

'----------------------------------------------------
' 以下は↑のプログラムから呼び出すコード（再帰処理用）
' おまじないと考えてOK。意味も分からず追加してください。
'----------------------------------------------------
Sub GetFolder(Path)
    Dim buf As String, f As Object
    
    If Right(Path, 1) <> "\" Then
        Path = Path & "\"
    End If
    
    With CreateObject("Scripting.FileSystemObject")
    For Each f In .GetFolder(Path).SubFolders
        Call GetFolder(f.Path)
    Next f
    End With
    
    buf = Dir(Path & "*.*")
    Do While buf <> ""
        cnt = cnt + 1
        ReDim Preserve folderPathArray(cnt)
        folderPathArray(cnt) = Path & buf
        buf = Dir()
    Loop

End Sub

学べる内容

エクセルファイルで作られた申請書を一つずつ開いてコピーすることなんてめちゃめちゃありますよね。

そんなときにこのコード利用していただければ同僚から感動されること間違いなしです。

  • エクセルファイルを開いて操作する
  • デバッグ
    • ブレークポイント
    • ステップイン
  • ループ（カウンタの利用）

 

さいごに

基礎はあともう一つで終わりにしようかなあとか考えています。

なんか教えておいた方が良いことあるかなあ。詰め込みすぎた・・・ではまた！