ExcelVBAによるファイル処理

ファイルダイアログ（オープン）
CSVをUTF-8で保存する

ファイルダイアログ（オープン）†

   Dim dlg As FileDialog
   Set dlg = Application.FileDialog(msoFileDialogOpen)
   dlg.InitialFileName = "C:\Windows\"
   dlg.Show 'execute だと開く所までやってくれる
   
   Cells(1, 1) = dlg.SelectedItems(1)

[VBA]フォルダ選択ダイアログの使い方・使い分け 2021

Win32APIを直叩きしたい場合

https://www.moug.net/tech/acvba/0020007.html

Public Declare Function GetOpenFileName _
                       Lib "comdlg32.dll" _
                         Alias "GetOpenFileNameA" ( _
                         pOpenFileName As OPENFILENAME) As Long

'pOpenFileName構造体(ユーザー定義型)の宣言
Type OPENFILENAME
    lStructSize       As Long    '構造体のサイズ
    hwndOwner         As Long    'ダイアログを所有
                                 '  するウインドウハンドル
    hInstance         As Long    'アプリケーションインスタンス
    lpstrFilter       As String  'フィルタ
    lpstrCustomFilter As Long    'ユーザ定義フィルタ
    nMaxCustrFilter   As Long    'ユーザ定義フィルタの
                                 '  バッファサイズ
    nFilterIndex      As Long    'デフォルトフィルタのインデックス
    lpstrFile         As String  '選択されたファイル名
    nMaxFile          As Long    'ファイル名のバッファ
    lpstrFileTitle    As String  '選択されたファイル名のタイトル
    nMaxFileTitle     As Long    'ファイル名のタイトルのバッファ
    lpstrInitialDir   As String  '初期ディレクトリ
    lpstrTitle        As String  'ダイアログボックスのタイトル
    Flags             As Long    'オプション
    nFileOffset       As Integer 'ファイル名の最後の「\」までの
                                 '  オフセット値
    nFileExtension    As Integer '拡張子までのオフセット値
    lpstrDefExt       As String  'デフォルトの拡張子
    lCustrData        As Long    'OSがフック関数に渡すアプリ定義のデータ
    lpfnHook          As Long    'メッセージを処理するフック関数
                                 '  へのポインタ
    lpTemplateName    As Long
End Type

'定数宣言
'複数のファイルを選択可能に
Public Const OFN_ALLOWMULTISELECT = &H200
'ファイルが存在しなかった場合、新規作成するかどうか表示
Public Const OFN_CREATEPROMPT = &H2000
'エクスプローラ形式のダイアログを使用
Public Const OFN_EXPLORER = &H80000
'存在しないファイル名を入力不可に
Public Const OFN_FILEMUSTEXIST = &H1000
'「読み取り専用」チェックボックスを非表示
Public Const OFN_HIDEREADONLY = &H4
'カレントディレクトリをダイアログのカレントディレクトリにする
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_NODEREFERENCELINKS = &H100000
'ネットワークコンピュータを非表示に
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOVALIDATE = &H100
'ファイルが存在していた場合、上書きを問い合わせる
Public Const OFN_OVERWRITEPROMPT = &H2
'有効なパス名のみを入力可能に
Public Const OFN_PATHMUSTEXIST = &H800
'「読み取り専用」チェックボックスをオンにする
Public Const OFN_READONLY = &H1
'「ヘルプ」ボタンの表示
Public Const OFN_SHOWHELP = &H10
'拡張子がデフォルトの拡張子と異なる場合に設定されるフラグ
Public Const OFN_EXTENSIONDIFFERENT = &H400

Public Function GetFileName() As String
    Dim pOpenFileName As OPENFILENAME
    Dim lngRet As Long

    'Accessアプリケーションのハンドルを取得
    pOpenFileName.hwndOwner = Application.hWndAccessApp
    pOpenFileName.hInstance = 0
    'ファイルフィルタの設定
    pOpenFileName.lpstrFilter = "全てのファイル (*.*)" & _
                                String(1, vbNullChar) & _
                                "*.*" & _
                                String(2, vbNullChar)
    pOpenFileName.lpstrCustomFilter = 0
    pOpenFileName.nMaxCustrFilter = 0
    pOpenFileName.nFilterIndex = 1
    pOpenFileName.lpstrFile = String(511, vbNullChar)
    pOpenFileName.nMaxFile = 511
    pOpenFileName.lpstrFileTitle = String(512, vbNullChar)
    pOpenFileName.nMaxFileTitle = 511
    pOpenFileName.lpstrInitialDir = String(1, vbNullChar)
    pOpenFileName.lpstrTitle = String(1, vbNullChar)
    pOpenFileName.nFileOffset = 0
    pOpenFileName.nFileExtension = 0
    pOpenFileName.lpstrDefExt = String(1, vbNullChar)
    pOpenFileName.lCustrData = 0
    pOpenFileName.lpfnHook = 0
    pOpenFileName.lpTemplateName = 0
    pOpenFileName.lStructSize = Len(pOpenFileName)
    '読取専用ファイルを隠す
    pOpenFileName.Flags = OFN_HIDEREADONLY _
                          Or OFN_EXPLORER

    lngRet = GetOpenFileName(pOpenFileName)

    GetFileName = Left(pOpenFileName.lpstrFile, _
                       InStr(pOpenFileName.lpstrFile, vbNullChar) - 1)

End Function

↑

CSVをUTF-8で保存する†

通常のSave機能ではUnicodeまでしか指定できないが、いくつか方法はある
フリーのモジュールを使用する方法
- http://www.vector.co.jp/soft/winnt/prog/se320375.html

ADODB.Streamを使う方法

   Dim myFileName As String
   Dim myPath As String
   Dim NewFileName As String
   
   myFileName = ActiveWorkbook.name
   myPath = ActiveWorkbook.Path
   
   Dim outbook As Workbook
   Set outbook = ActiveWorkbook
   Dim sht As Worksheet

   Dim i As Integer
   For i = 1 To ActiveWorkbook.Worksheets.Count
       Windows(myFileName).Activate
       NewFileName = ActiveWorkbook.Worksheets(i).name
       Set sht = outbook.Worksheets(i)
       Dim StreamIn As Object
       Set StreamIn = CreateObject("ADODB.Stream")
       With StreamIn
           .Open
           .Charset = "shift_jis"
           .Type = 2
           .Position = 0
       End With
   
       Dim StreamOut As Object
       Set StreamOut = CreateObject("ADODB.Stream")
       With StreamOut
           .Open
           .Charset = "UTF-8"
           .Type = 2
           .Position = 0
       End With
   
       Dim row As Integer
       row = sht.UsedRange.Cells(sht.UsedRange.Count).row

       Dim line As Integer
       line = sht.UsedRange.Cells(sht.UsedRange.Count).Column

       Dim fileName As String
       fileName = myPath & "\" & NewFileName & ".dat"

       Dim r As Integer
       For r = 1 To row
           Dim l As Integer
           For l = 1 To line - 1
               StreamIn.WriteText sht.Cells(r, l) & ","
           Next
           StreamIn.WriteText sht.Cells(r, line), 1
       Next
       
       StreamIn.SetEOS
       StreamIn.Position = 0

       StreamIn.CopyTo StreamOut
       StreamOut.SetEOS
       StreamOut.Position = 0
       
       StreamOut.SaveToFile fileName, 2
       StreamIn.Close
       StreamOut.Close
       Set StreamIn = Nothing
       Set StreamOut = Nothing
   Next i

エクセルVBAでBOM無しのUTF-8でCSVファイルなどを出力する方法 2016

ExcelVBAによるファイル処理

ファイルダイアログ（オープン）†

CSVをUTF-8で保存する†

最新の50件