| |
>UNIXから取得したログファイルをエクセルへ取り込むという処理をしています｡
>
>Open Filepath For Input As #1
> Do Until EOF(1)
> Input #1, OneLineDate
>
> Loop
>Close #1
>上記のように､ファイルを開く→行があるかぎり1行づつ読み出す
>という処理をしたいのですが､
>UNIXから落ちたデータなので改行コードがCRになっているらしく
>全行を1行とみなしてしまったいます｡
>
>そこで､ファイルオープン時､CRLFに変換をしてから開く､
>という方法はないでしょうか？
UNIX系の改行コードは、確か、Lfだと思います
また、Openステートメントは、CｒLf、Crを改行コードと見なしますので
Crなら其のまま読みこめます
Lｆの改行コードの場合、FSOのTextStreamなら、CrLf、Lfを改行コードとしますので
FSOなら、置換をしなくとも読めると思います
以下に、読み込みのコード例をUpします
今、手元にLfのファイルが無いので試せませんが、多分このコードで大丈夫だと思います
Option Explicit
Public Sub ReadCsvFSO()
Dim i As Long
Dim vntFileName As Variant
'読み込むファイルを指定
If Not GetReadFile(vntFileName, ThisWorkbook.Path) Then
Exit Sub
End If
'読み込みファイルのデータをシートに出力
'第１引数 読み込みファイル名
'第２引数 書き込むシート
'第３引数 書き込み始める行位置
'第４引数 書き込み始める列位置
CSVReadFSO vntFileName, ActiveSheet, 1, 1, True, ","
End Sub
Private Sub CSVReadFSO(ByVal strFileName As String, _
ByVal wksWrite As Worksheet, _
Optional ByRef lngRow As Long = 1, _
Optional ByRef lngCol As Long = 1, _
Optional ByRef blnHeader As Boolean = True, _
Optional strDelim As String = ",")
' CSVデータの読み込み
Dim vntField As Variant
Dim strLine As String
Dim blnMulti As Boolean
Dim strRec As String
Dim objFso As Object
Dim objFileStr As Object
Const ForReading = 1
'FSOのオブジェクトを取得
Set objFso = CreateObject("Scripting.FileSystemObject")
'指定ファイルを読み込みモードでOpen
Set objFileStr = objFso.OpenTextFile(strFileName, ForReading)
With objFileStr
'ファイルの終り迄繰り返し
Do Until .AtEndOfStream
'ファイルから１行読み込み
strLine = .ReadLine
'読み込み行を論理レコードに追加
strRec = strRec & strLine
'CSVをフィールドに分割
vntField = SplitCsv(strRec, strDelim, , , blnMulti)
'もし、論理レコードに成らない場合
If blnMulti Then
'論理レコードにLfを追加
strRec = strRec & vbLf
Else
If blnHeader Then
'指定シートの指定行列位置について
With wksWrite.Cells(lngRow, lngCol)
'フィールドの書き込み
.Resize(, UBound(vntField) + 1).Value = vntField
End With
'書き込み行位置を更新
lngRow = lngRow + 1
End If
'論理レコードを初期化
strRec = ""
blnHeader = True
End If
Loop
'ファイルをClose
.Close
End With
Set objFileStr = Nothing
Set objFso = Nothing
End Sub
Private Function SplitCsv(ByVal strLine As String, _
Optional strDelimiter As String = ",", _
Optional strQuote As String = """", _
Optional strRet As String = vbCrLf, _
Optional blnMulti As Boolean) As Variant
' strLine :分割元と成る文字列
' strDelimiter :区切り文字
' SplitCsv :戻り値、切り出された文字配列
Dim lngDPos As Long
Dim vntData() As Variant
Dim lngStart As Long
Dim i As Long
Dim vntField As Variant
Dim lngLength As Long
i = 0
lngStart = 1
lngLength = Len(strLine)
blnMulti = False
Do
ReDim Preserve vntData(i)
If Mid$(strLine, lngStart, 1) <> strQuote Then
lngDPos = InStr(lngStart, strLine, _
strDelimiter, vbBinaryCompare)
If lngDPos > 0 Then
vntField = Mid$(strLine, lngStart, _
lngDPos - lngStart)
If lngDPos = lngLength Then
ReDim Preserve vntData(i + 1)
End If
lngStart = lngDPos + 1
Else
vntField = Mid$(strLine, lngStart)
lngStart = lngLength + 1
End If
Else
lngStart = lngStart + 1
Do
lngDPos = InStr(lngStart, strLine, _
strQuote, vbBinaryCompare)
If lngDPos > 0 Then
vntField = vntField & Mid$(strLine, _
lngStart, lngDPos - lngStart)
lngStart = lngDPos + 1
Select Case Mid$(strLine, lngStart, 1)
Case ""
Exit Do
Case strDelimiter
lngStart = lngStart + 1
Exit Do
Case strQuote
lngStart = lngStart + 1
vntField = vntField & strQuote
End Select
Else
blnMulti = True
vntField = Mid$(strLine, lngStart) & strRet
lngStart = lngLength + 1
Exit Do
End If
Loop
End If
vntData(i) = vntField
vntField = Empty
i = i + 1
Loop Until lngLength < lngStart
SplitCsv = vntData()
End Function
Private 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
|
|
Hirofumi
- 05/3/22(火) 19:05 -
