メルマガの文章を指定バイト数で改行する処理を自動化しました。下記プログラムは、テキストファイルをダイアログから開き、50バイトごとに改行を挿入した後、別ファイル名で保存してくれます。
Option Explicit
Sub kaigyou()
Dim file_path As String 'ファイルパス
Dim buf As String '1行バッファ
Dim i As Long 'for
Dim cnt As Long '文字列のバイト数
Dim filename_with_extention As String '拡張子ありのファイル名
Dim filename_without_extention As String '拡張子なしのファイル名
Dim a As Long
Dim b As Long
Dim moji As String
Dim maxlen As Long
maxlen = 50 '50バイトで改行
'----- カレントディレクトリにチェンジする(後でファイルダイヤログが展開されるところ)
With CreateObject("WScript.Shell")
.CurrentDirectory = ThisWorkbook.Path + "\"
End With
file_path = Application.GetOpenFilename("テキストファイル,*.txt") 'ファイルダイヤログを表示
If file_path = "False" Then 'ダイヤログで読み込みがキャンセルされたら何もせずに終了する
Exit Sub
End If
filename_with_extention = Mid(file_path, InStrRev(file_path, "\") + 1) '\を左からサーチ
filename_without_extention = Left(filename_with_extention, InStrRev(filename_with_extention, ".") - 1) '拡張子を除去
'----- ファイルからデータを取得する
Open file_path For Input As #1 'ファイルを開く
Open ThisWorkbook.Path & "\" & filename_without_extention & "_" & maxlen & "byteで改行" & ".txt" For Output As #2
Do Until EOF(1) 'ファイルの終わりまで繰り返す
Line Input #1, buf '1行バッファに読み込む
a = Len(buf) '文字数(事前に規定の文字コード(ANSI)に変換)
b = LenB(StrConv(buf, vbFromUnicode)) '文字のバイト数(事前に規定の文字コード(ANSI)に変換)
If b <= maxlen Then
Print #2, buf
Else
cnt = 0 'バイト数を初期化する
For i = 1 To a
moji = Mid(buf, i, 1)
cnt = cnt + LenB(StrConv(moji, vbFromUnicode)) '半角は1バイト、全角は2バイトとしてカウント
Print #2, moji;
If maxlen <= cnt Then '文字数maxlenに達したら
Print #2, '改行を入れる
cnt = 0
End If
Next
If cnt <> 0 Then
Print #2,
End If
End If
Loop
Close #1 'ファイルを閉じる
Close #2
End Sub