ExcelVBAによるファイル処理
をテンプレートにして作成
[
トップ
] [
新規
|
一覧
|
検索
|
最終更新
|
ヘルプ
|
ログイン
] [
Twitter
]
開始行:
→ExcelのVBA
#contents
* ファイルダイアログ(オープン) [#f5041b4a]
Dim dlg As FileDialog
Set dlg = Application.FileDialog(msoFileDialogOpen)
dlg.InitialFileName = "C:\Windows\"
dlg.Show 'execute だと開く所までやってくれる
Cells(1, 1) = dlg.SelectedItems(1)
-[[[VBA]フォルダ選択ダイアログの使い方・使い分け>https://...
-Win32APIを直叩きしたい場合
--https://www.moug.net/tech/acvba/0020007.html
Public Declare Function GetOpenFileName _
Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" ( _
pOpenFileName As OPENFILENAME) ...
'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, vb...
End Function
*CSVをUTF-8で保存する [#l005b80d]
-通常の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).C...
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ファイルなどを出力する...
終了行:
→ExcelのVBA
#contents
* ファイルダイアログ(オープン) [#f5041b4a]
Dim dlg As FileDialog
Set dlg = Application.FileDialog(msoFileDialogOpen)
dlg.InitialFileName = "C:\Windows\"
dlg.Show 'execute だと開く所までやってくれる
Cells(1, 1) = dlg.SelectedItems(1)
-[[[VBA]フォルダ選択ダイアログの使い方・使い分け>https://...
-Win32APIを直叩きしたい場合
--https://www.moug.net/tech/acvba/0020007.html
Public Declare Function GetOpenFileName _
Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" ( _
pOpenFileName As OPENFILENAME) ...
'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, vb...
End Function
*CSVをUTF-8で保存する [#l005b80d]
-通常の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).C...
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ファイルなどを出力する...
ページ名: