このページにはHTMLファイル生成等に利用できるマクロの部品を置いています．
原稿のExcelファイルを集約したり，テキストファイルへ書き出すために，以下のマクロをCallしてご利用ください．

目次

  1. OSに応じたセパレータ
  2. 複数ファイルにマクロ実行
  3. ワークシートのテキストファイル書き出し
  4. ファイル複製

OSに応じたセパレータ

macOSとWindowsで共通して走るマクロを作成するため，いずれのOSの場合でもディレクトリのセパレータを変数sepで表すことにするマクロです．

メインのマクロより先に次を宣言した上で，

Public sep As String

次のマクロを適当な位置で実行します．

Sub OSに応じたセパレータ()

    'macOSとWindowsでファイルパスの区切り文字が異なるため、両方でマクロを使えるように、区切り文字自体を変数にしておく。

    If Application.OperatingSystem Like "*Mac*" Then
        sep = "/"
    Else
        sep = Chr(92)
    End If

End Sub

複数ファイルにマクロ実行

マクロ本体のあるディレクトリ内で，xlsやxlsxなど.xlsを拡張子名に含んだファイル全てを対象として，指定されたマクロを実行します．

メインのマクロより先に次を宣言した上で，

Public grbFileName

次のマクロを適当な位置で実行します．

Sub 複数ファイルにマクロ実行()
    
	Dim i As Long
	Dim filePath As String
	
	i = 1
	filePath = ThisWorkbook.Path & sep & "*.xls*"  'OSに応じて「sep」にディレクトリの適当なセパレータを入れてください。macOSなら「"/"」です。
	grbFileName = ""
	grbFileName = Dir(filePath)
	
	Do While grbFileName <> ""
		Call マクロ  'マクロ内で「grbFileName」を指定しつつ処理を進行してください。
		i = i + 1
		grbFileName = Dir()
	Loop

End Sub

ワークシートのテキストファイル書き出し

テキストファイルでの出力を行いたい場合に使用するマクロです．
VBAによるエンコードはShift-JISで行われます．

マクロの第1引数には，例えば，ws = Worksheets("Sheet1")としたwsを入れて，どのワークシートをテキストファイルにするか定めます．
出力ファイル名を表す第2引数outputFilePathには，拡張子.html等も指定することができます．

Sub ワークシートのテキストファイル書き出し(inputWorksheet As Worksheet, outputFilePath As String)
    
    'このマクロは指定されたワークシートのA列を上から読み込み、その内容をテキストファイルに書き出します。
    '同一ファイル名が存在する場合の処理は、追記でなく上書きです。
    '空白行にあたったら、このマクロの処理を終了します。
    
    Dim i As Long
    
    Open outputFilePath For Output As #1
        i = 1
        Do While inputWorksheet.Cells(i, 1) <> ""
            Print #1, inputWorksheet.Cells(i, 1)
            Print #1, vbLf
            i = i + 1
        Loop
    Close #1
    
End Sub

ファイル複製

画像等のファイルを複製するマクロです．

第1引数には，例えば，ws = Worksheets("Sheet1")としたwsを入れて使います．
そのシートにおいて，第2引数と第3引数で列番を指定します．
第2引数で指定する列番はオリジナルのファイルパスが列挙されている列であり，第3引数はコピー先のパスが列挙されているものです．

Sub ファイル複製(inputWorksheet As Worksheet, originalFullPathCol As Long, copiedFullPathCol As Long)

    'ファイルを指定したフォルダに複製するマクロです。
    '格納フォルダは実行中のマクロ本体と同じ階層に作られます。
    'ワークシート（inputWorksheet）でオリジナルファイル名の記載された列（originalFullPathCol）とリネーム後ファイル名の記載された列（copiedFullPathCol）を逐次読み込み、リネーム後の名前が空白になったときに終了します。
    
    Dim i As Long: i = 2  '見出し行ありの前提で2行目から処理開始
    Dim original As String
    Dim copied As String: copied = inputWorksheet.Cells(i, copiedFullPathCol)
    
    Do While copied <> ""
        original = inputWorksheet.Cells(i, originalFullPathCol)
        copied = inputWorksheet.Cells(i, copiedFullPathCol)
        If original <> "" Then
            FileCopy original, copied
        End If
        i = i + 1
    Loop
    
End Sub