1.きっかけ
前回、『IIJ セキュアMX メールボックスプラス』のユーザー一括登録用テキスト出力マクロの作成を行いまして、
ユーザメールの一括登録は出来たのですが、
その後、ダウンロードした「ユーザ登録一覧」(タブ区切りテキスト(一部カンマ区切りも使用))をそのまま台帳に表示したいと思い、
こちらもExcelVBAで読み込む仕組みを作っておきました。
→将来的にはテキスト出力も統合したいと思っています。
2.作成
(2)そして恒例のchatGPTにインプットしてベースのコードを作ってもらいました。
【参考:以下クリックで展開】SMXメールボックスプラスのユーザ一覧テキスト読取マクロ(chatGPTへのインプット)
次のExcelVBAコード(標準モジュール)「sub SMXテキストインポート()」を書いてください。
[動作の説明]
1. アクティブなシート上で動作する。
2. C1セルのハイパーリンクをクリックすると「sub SMXテキストインポート()」が起動する。
3. 任意の読み込むテキストのファイル選択ダイアログが起動し、読み込むテキストを選択する。
4. テキストの「#」で始まる行は読み込みを無視される。
5. 読み込むテキストの行末には、キャリッジリターンとラインフィードの文字コード(定数: vbCrLf)が書かれており、データがEOFするまで、次の行へ読み込みが繰り返される。
6. 読み込む際に「先頭と末尾のスペースは削除」する。
7. 11行目からのA列~L列に、ファイル選択された「タブ区切りのテキスト」データが、セルごとに読み込まれる。
7.1.1. ただし、途中D列~I列は、データをセルに読み込む区切り文字がタブでは無く、「カンマ区切りのテキスト」である。
7.1.2. D列~I列は、「カンマ区切りのテキスト」で、先頭データが「*」で始まるが、「*」が無い場合は、D列は、Null値として、次のE列へとデータ読み込みを移動する。
7.1.3. E列~I列は、「カンマ区切りのテキスト」で、「メールアドレス」が読み取れるはずだが、「メールアドレス」が無い場合は、Null値として、I列までデータ読み込みを繰り返し行う。
[読み込むテキストデータの構造(サンプル)]
# メールボックスプラスユーザ一覧
# ダウンロード実施 2023年07月20日 16時35分46秒
# (#で始まる行はアップロード時に破棄されます)
# ユーザのメールアドレス # パスワード # メモ欄 # 転送先メールアドレス # エンドユーザによるメール転送/フィルタ設定の可否 # 設定容量 # タイムゾーン # MailTAPへのログイン
aa-a@example.com password AAAさん eee@example.com y 1 +0900 y
b-bb@example.com pass1234 BBBさん y 1 +0900 y
ccc@example.com 1223456 CCCチーム *,eee@example.com,fff@example.com,ggg@example.com,hhh@example.com y 1 +0900 y
ddd@example.com password1 DDDさん *,bbb@example.com,iii@example.com,hhh@example.com y 1 +0900 y
以上
【参考:以下クリックで展開】最初にchatGPTが出力したコード→文字のエスケープやカンマ区切りの再配列が上手くいかず。。
Sub SMXテキストインポート()
Dim filePath As Variant
filePath = Application.GetOpenFilename("テキストファイル (*.txt), *.txt") ' テキストファイルを選択するダイアログを表示
If filePath = False Then
MsgBox "ファイルが選択されませんでした。", vbExclamation
Exit Sub
End If
Dim textData As String
Open filePath For Input As #1 ' テキストファイルをテキストモードで開く
Do Until EOF(1)
Line Input #1, textLine
If Not textLine Like "#*" And textLine <> "" Then ' #で始まる行と空行を無視
textData = textData & textLine & vbCrLf
End If
Loop
Close #1
Dim lines() As String
lines = Split(textData, vbCrLf) ' 改行文字で行を分割
Dim ws As Worksheet
Set ws = ActiveSheet ' アクティブなシートを取得
Dim rowData As Variant
Dim i As Long, j As Long, k As Long
Dim emailData As Variant
For i = 0 To UBound(lines)
rowData = Split(Trim(lines(i)), vbTab) ' タブ区切りでデータを分割して配列に格納
' D列~I列をカンマ区切りで更に分割して配列に格納
If UBound(rowData) >= 3 Then ' データの要素が3つ以上あるかチェック
emailData = Split(rowData(3), ",")
For j = 4 To 8
If UBound(emailData) >= j - 3 Then
emailData(j - 4) = Trim(emailData(j - 3))
Else
emailData(j - 4) = "" ' 空文字列を設定
End If
Next j
' カンマ区切りのテキストが"*"で始まる場合の処理
If emailData(0) = "*" Then
rowData(3) = Null
For k = 5 To 9
If UBound(emailData) >= k - 3 Then
rowData(k) = emailData(k - 3)
Else
rowData(k) = "" ' 空文字列を設定
End If
Next k
Else
' メールアドレスが存在しない場合の処理
For k = 3 To 8
If UBound(emailData) >= k - 3 Then
rowData(k) = emailData(k - 3)
Else
rowData(k) = "" ' 空文字列を設定
End If
Next k
End If
End If
' 行のデータをシートに書き込む
ws.Cells(11 + i, 1).Resize(1, 12).Value = rowData
Next i
MsgBox "データのインポートが完了しました。", vbInformation
End Sub
(3)実際のコード(chatGPTの出力から、一部手直し)
Sub SMXテキストインポート()
' セルのクリアと書式設定
Range("A11:M1000").Select
Selection.NumberFormatLocal = "@" ' セルの書式を”文字列”とする
Selection.ClearContents
Range("J:J").Select
Selection.NumberFormatLocal = "0" ' J列の書式を”数値(整数)”とする
Rows("10:10").Select
' テキストファイルを選択するダイアログを表示
Dim filePath As Variant
filePath = Application.GetOpenFilename("テキストファイル (*.txt), *.txt")
If filePath = False Then
MsgBox "ファイルが選択されませんでした。", vbExclamation
Exit Sub
End If
' テキストファイルをテキストモードで開く
Dim textData As String
Open filePath For Input As #1
Do Until EOF(1)
Line Input #1, textLine
If Not textLine Like "[#]*" And textLine <> "" Then ' #で始まる行と空行を無視
textData = textData & textLine & vbCrLf
End If
Loop
Close #1
Dim lines() As String
lines = Split(textData, vbCrLf) ' 改行文字で行を分割
Dim ws As Worksheet
Set ws = ActiveSheet ' アクティブなシートを取得
Dim rowData As Variant
Dim exData() As Variant
Dim i As Long, j As Long, k As Long
Dim emailData As Variant
For i = 0 To UBound(lines) - 1
rowData = Split(Trim(lines(i)), vbTab) ' タブ区切りでデータを分割してrowData配列に格納
For ii = 0 To 11
ReDim Preserve exData(ii)
If ii < 4 Then ' exData(0~3)には、rowData(0~3)をコピーする
exData(ii) = rowData(ii)
End If
If ii > 3 And ii < 9 Then ' exData(4~8)には、""を書き込む
exData(ii) = ""
End If
If ii > 8 Then
exData(ii) = rowData(ii - 4) 'exData(9-11)には、rowData(4~7)をコピーする
End If
Next ii
' D列~I列をカンマ区切りで更に分割して配列に格納
If Not rowData(3) = "" Then ' rowData(3)が""では無いとき
emailData = Split(rowData(3), ",") 'カンマ区切りでデータを分割してemailData配列に格納
If emailData(0) = "*" Then ' 更にemailData(0)が*であったとき
For iii = 0 To UBound(emailData)
exData(iii + 3) = emailData(iii)
' exData(4)は、emailData(0)に書き換え(*が入る)
' exData(5)以降は、emailData(1)以降に書き換え(転送メール1~5が入る。空欄ではない場合)
Next iii
Else ' 更にemailData(0)が*では無かったとき
exData(3) = "" ' exData(3)は、""が入る
For iii = 0 To UBound(emailData)
exData(iii + 4) = emailData(iii)
' exData(4)以降は、emailData(0)以降に書き換え(転送メール1~5が入る。空欄ではない場合)
Next iii
End If
End If
ws.Cells(11 + i, 1).Resize(1, 12).Value = exData
Next i
MsgBox "データのインポートが完了しました。", vbInformation
End Sub
3.利用の様子
SMXメールボックスプラス_ユーザ一覧テキスト読取マクロ_動作の様子
以上です。