0
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 1 year has passed since last update.

お題は不問!Qiita Engineer Festa 2023で記事投稿!

『IIJ セキュアMX メールボックスプラス』のユーザ一覧テキスト読取マクロの作成

Last updated at Posted at 2023-07-21

1.きっかけ

前回、『IIJ セキュアMX メールボックスプラス』のユーザー一括登録用テキスト出力マクロの作成を行いまして、
ユーザメールの一括登録は出来たのですが、
その後、ダウンロードした「ユーザ登録一覧」(タブ区切りテキスト(一部カンマ区切りも使用))をそのまま台帳に表示したいと思い、
こちらもExcelVBAで読み込む仕組みを作っておきました。
→将来的にはテキスト出力も統合したいと思っています。

2.作成

(1)Excelシートのレイアウト
SMXメールボックスプラス_ユーザ一覧テキスト読取マクロ_レイアウト.png

(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メールボックスプラス_ユーザ一覧テキスト読取マクロ_動作の様子
SMXメールボックスプラス_ユーザ一覧テキスト読取マクロ_動作の様子.gif

以上です。

0
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?