Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


58044 / 76732 ←次へ | 前へ→

【23422】Re:改行コードをCR→CRLEに変換してファイルOpen
回答  Hirofumi  - 05/3/22(火) 19:05 -

引用なし
パスワード
   >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ステートメントは、CrLf、Crを改行コードと見なしますので
Crなら其のまま読みこめます
Lfの改行コードの場合、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
  
  '読み込みファイルのデータをシートに出力
  '第1引数 読み込みファイル名
  '第2引数 書き込むシート
  '第3引数 書き込み始める行位置
  '第4引数 書き込み始める列位置
  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
      'ファイルから1行読み込み
      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
2 hits

【23411】改行コードをCR→CRLEに変換してファイルOpen LilHeart 05/3/22(火) 11:17 質問
【23419】Re:改行コードをCR→CRLEに変換してファイ... ichinose 05/3/22(火) 17:52 発言
【23443】Re:改行コードをCR→CRLEに変換してファイ... LilHeart 05/3/23(水) 14:06 お礼
【23422】Re:改行コードをCR→CRLEに変換してファイ... Hirofumi 05/3/22(火) 19:05 回答
【23424】Re:改行コードをCR→CRLEに変換してファイ... Hirofumi 05/3/22(火) 20:11 回答
【23445】Re:改行コードをCR→CRLEに変換してファイ... LilHeart 05/3/23(水) 14:09 お礼

58044 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free