１．きっかけ
『IIJ セキュアMX メールボックスプラス』へのメール移行も完了し運用が行えましたので、
次に「メール送受信対策添付ファイルURL化（脱PPAP）」に着手しようと『IIJ ドキュメントエクスチェンジサービス(DOX)』を契約しました。
さて設定してみようと思いましたら・・・どうやら１からユーザーアカウントを作らないとならない様子。。
「CSVから一括登録」という機能はあるですが、そもそもそのCSVファイルを作らないとなりませんでした。
そこで、前回作っていた『IIJ セキュアMX メールボックスプラス』のユーザ一覧テキスト読取マクロの作成で運用しているマクロ付きブックに、
「DOX一括アカウント用CSV書き出し」機能マクロを追加することにしました。
２．作成
（１）サンプルのCSVファイルを取得する
- まずは数ユーザ（DOXの一般と管理者）を手入力して、そのCSVデータをダウンロードしテンプレートを確認しました。
（２）恒例のchatGPTにインプットしてベースのコードを作ってもう
【参考：以下クリックで展開】DOX一括アカウント用CSV書き出しマクロ生成依頼（chatGPT4へインプットしたプロンプト）
# 次の機能を実現するExcelVBAのSubプロシージャを作ってください。
## やりたいこと
- 既にデータの入っているアクティブなシートから、指定したセルの値を読み込んで、
新たなCSVファイル「DOX_${シート名}_accounts_${yyyymmdd}.csv」として生成する。
- 生成するCSVファイルの保存先を、ファイルウィンドウから選択できる。
## 生成されるCSVファイルのテンプレート
- 必ず項目の校正順番は厳守すること。
- カンマ区切り、文字コードは「SHIFT-JIS」、行末は「CR+LF」
```
アカウント名,パスワード,メールアドレス,コメント,パスワードの再利用,パスワード有効期間,アカウント有効期限,所属プロジェクト,管理プロジェクト,メール管理者
d_example.com,passWord123,d@example.com,"SMXの主契約",yes,,,,,yes
h_example.com,Password321,h@example.com,"姓 名",yes,,,,,no
```
## 説明
- 「メールアドレス」（３列目）: セル「A11」から始まる列を、セルの値が無いものを除いて順番に取得して、書き出す。
- 「アカウント名」（１列目）: 「メールアドレス」の値の「@」（アットマーク）を「_」（アンダースコア）に変換して、書き出す。
- 「パスワード」（２列目）: セル「B11」から始まる列を、セルの値が無いものを除いて順番に取得して、書き出す。
- 「コメント」（４列目）: セル「C11」から始まる列を、値の前後に「"」（ダブルクォーテーション）を付けて囲んで書き出す。
- 「パスワードの再利用」（５列目）: 全て「yes」の値を書き出す。
- 「パスワード有効期間」（６列目）: 値なし（空欄）の状態で書き出す。
- 「アカウント有効期限」（７列目）: 値なし（空欄）の状態で書き出す。
- 「所属プロジェクト」（８列目）: 値なし（空欄）の状態で書き出す。
- 「管理プロジェクト」（９列目）: 値なし（空欄）の状態で書き出す。
- 「メール管理者」（１０列目）: 「コメント」の値に「主契約」の文字が含まれていた場合は「yes」を、そうでない場合は「no」を書き出す。
以上です。
よろしくお願いします。
（３）実際のコード
- chatGPT4の出力から、ほんの一部（Subプロシージャ名と最後のメッセージ追加）手直し程度でした。
- 数回同じプロンプトでコードを書いてもらい、良さそうなのを選択。（いくつかはCSVの項目行を生成していなかったりしました。）
- おや、、良く見たら無駄に使われていないyyyymmdd変数が作られていますね。。
Sub DOX一括アカウント用CSV書き出し()
Dim FileName As String
Dim FilePath As String
Dim SheetName As String
Dim FileContent As String
Dim iRow As Long
Dim fs As Object
Dim FileOut As Object
Dim Mail, Account, Pass, Comment, Admin As String
Dim DateFormatted As String
Dim yyyymmdd As String
DateFormatted = Format(Date, "yyyymmdd")
' Get the active sheet name
SheetName = ActiveSheet.Name
FileName = "DOX_" & SheetName & "_accounts_" & DateFormatted & ".csv"
FilePath = Application.GetSaveAsFilename(FileName, "CSV Files (*.csv), *.csv", Title = "Please select folder to save CSV file")
' Check if user cancelled
If FilePath = "False" Then
MsgBox "CSV file not created. Operation cancelled by user."
Exit Sub
End If
' Create a string representing CSV File
FileContent = "アカウント名,パスワード,メールアドレス,コメント,パスワードの再利用,パスワード有効期間,アカウント有効期限,所属プロジェクト,管理プロジェクト,メール管理者" & vbLf
iRow = 11
' Continue until Mail value is empty
Do Until IsEmpty(Cells(iRow, 1).Value)
Mail = Cells(iRow, 1).Value
Account = Replace(Mail, "@", "_")
Pass = Cells(iRow, 2).Value
Comment = """" & Cells(iRow, 3).Value & """"
If InStr(1, Comment, "主契約") > 0 Then
Admin = "yes"
Else
Admin = "no"
End If
FileContent = FileContent & Account & "," & Pass & "," & Mail & "," & Comment & ",yes,,,,," & Admin & vbLf
iRow = iRow + 1
Loop
' Save FileContent into CSV File
Set fs = CreateObject("ADODB.Stream")
fs.Type = 2 ' Specify stream type - we want To save text/string data.
fs.Charset = "Shift-JIS" ' Specify charset For the output text data.
fs.Open ' Open the stream And write binary data To the object
fs.WriteText FileContent
'Save binary data To disk
fs.SaveToFile FilePath, 2 '2 = overwrite exist
MsgBox "データのインポートが完了しました。", vbInformation
End Sub
３．利用の様子
以上です。