| |
CSVReadFSOは、Lf改行のTeｘｔをシートに読み込みます
Conversionは、Lf改行をCrLfに変換します
Option Explicit
Public Sub CSVReadFSO()
' Lfの改行コードのCSVをシートに読み込み
Dim vntFileName As Variant
Dim strFilter As String
Dim wksWrite As Worksheet
Dim lngRow As Long
Dim lngCol As Long
Dim vntField As Variant
Dim strBuff As String
Dim strProm As String
Dim objFso As Object
Dim objFileStr As Object
Const ForReading = 1
'フィルタ文字列を作成
strFilter = "CSV File (*.csv),*.csv"
'「ファイルを開く」ダイアログを表示
vntFileName _
= Application.GetOpenFilename(strFilter, 1)
If VarType(vntFileName) = vbBoolean Then
strProm = "マクロがキャンセルされました"
GoTo Wayout
End If
'書き込むシートを設定
Set wksWrite = ActiveSheet
'書き込み開始行を設定
lngRow = 1
'書き込み開始列を設定
lngCol = 1
'FSOのオブジェクトを取得
Set objFso = CreateObject("Scripting.FileSystemObject")
'指定ファイルを読み込みモードでOpen
Set objFileStr = objFso.OpenTextFile(vntFileName, ForReading)
With objFileStr
'ファイルの終り迄繰り返し
Do Until .AtEndOfStream
'ファイルから１行読み込み
strBuff = .ReadLine
'CSVをフィールドに分割
vntField = Split(strBuff, ",")
'指定シートの指定行列位置について
With wksWrite.Cells(lngRow, lngCol)
'フィールドの書き込み
.Resize(, UBound(vntField) + 1).Value = vntField
End With
'書き込み行位置を更新
lngRow = lngRow + 1
Loop
'ファイルをClose
.Close
End With
strProm = "処理が完了しました"
Wayout:
Set objFileStr = Nothing
Set objFso = Nothing
Set wksWrite = Nothing
MsgBox strProm, vbInformation
End Sub
Public Sub Conversion()
' 改行コード（Lf→CrLf）の変換
Dim dfn As Integer
Dim vntInFile As Variant
Dim vntOutFile As Variant
Dim strFilter As String
Dim strBuff As String
Dim strProm As String
Dim objFso As Object
Dim objFileStr As Object
Const ForReading = 1
'フィルタ文字列を作成
strFilter = "CSV File (*.csv),*.csv"
'「ファイルを開く」ダイアログを表示
vntInFile = Application.GetOpenFilename(strFilter, 1)
If VarType(vntInFile) = vbBoolean Then
strProm = "マクロがキャンセルされました"
GoTo Wayout
End If
'「ファイルを保存」ダイアログを表示
vntOutFile = Application.GetSaveAsFilename(vntOutFile, strFilter, 1)
If vntOutFile = False Then
strProm = "マクロがキャンセルされました"
GoTo Wayout
End If
If vntInFile = vntOutFile Then
strProm = "入力側と出力側のファイル名を別にして下さい"
GoTo Wayout
End If
'FSOのオブジェクトを取得
Set objFso = CreateObject("Scripting.FileSystemObject")
'指定ファイルを読み込みモードでOpen
Set objFileStr = objFso.OpenTextFile(vntInFile, ForReading)
'出力ファイルをOpen
dfn = FreeFile
Open vntOutFile For Output As dfn
With objFileStr
'ファイルの終り迄繰り返し
Do Until .AtEndOfStream
'ファイルから１行読み込み
strBuff = .ReadLine
'ファイルに１行出力
Print #dfn, strBuff
Loop
'ファイルをClose
.Close
Close dfn
End With
strProm = "処理が完了しました"
Wayout:
Set objFileStr = Nothing
Set objFso = Nothing
MsgBox strProm, vbInformation
End Sub
'「CSVReadFSO」で使用
Public Function GetReadFile(vntFileNames As Variant, _
Optional strFilePath As String, _
Optional blnMultiSel As Boolean _
= False) As Boolean
Dim strFilter As String
'フィルタ文字列を作成
strFilter = "CSV File (*.csv),*.csv," _
& "Text File (*.txt),*.txt," _
& "CSV and Text (*.csv; *.txt),*.csv;*.txt," _
& "全て (*.*),*.*"
'読み込むファイルの有るフォルダを指定
If strFilePath <> "" Then
'ファイルを開くダイアログ表示ホルダに移動
ChDrive Left(strFilePath, 1)
ChDir strFilePath
End If
'もし、ディフォルトのファイル名が有る場合
If vntFileNames <> "" Then
SendKeys vntFileNames & "{TAB}", False
End If
'「ファイルを開く」ダイアログを表示
vntFileNames _
= Application.GetOpenFilename(strFilter, 1, , , blnMultiSel)
If VarType(vntFileNames) = vbBoolean Then
Exit Function
End If
GetReadFile = True
End Function
'「CSVReadFSO」、「Conversion」で使用
Public Function GetWriteFile(vntFileName As Variant, _
Optional strFilePath As String) As Boolean
Dim strFilter As String
Dim strInitialFile As String
'フィルタ文字列を作成
strFilter = "CSV File (*.csv),*.csv," _
& "Text File (*.txt),*.txt"
'既定値のファイル名を設定
strInitialFile = vntFileName
'読み込むファイルの有るフォルダを指定
If strFilePath <> "" Then
'ファイルを開くダイアログ表示ホルダに移動
ChDrive Left(strFilePath, 1)
ChDir strFilePath
End If
'「ファイルを保存」ダイアログを表示
vntFileName _
= Application.GetSaveAsFilename(vntFileName, strFilter, 1)
If vntFileName = False Then
Exit Function
End If
GetWriteFile = True
End Function
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
