Excel VBA質問箱 IV

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

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


49754 / 76732 ←次へ | 前へ→

【31879】Re:テキストファイルの改行コードを変換
回答  Hirofumi  - 05/12/1(木) 19:52 -

引用なし
パスワード
   CSVReadFSOは、Lf改行のTextをシートに読み込みます
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
      'ファイルから1行読み込み
      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
      'ファイルから1行読み込み
      strBuff = .ReadLine
      'ファイルに1行出力
      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

1 hits

【31867】テキストファイルの改行コードを変換 ほびっと 05/12/1(木) 16:24 質問
【31879】Re:テキストファイルの改行コードを変換 Hirofumi 05/12/1(木) 19:52 回答
【31886】Re:テキストファイルの改行コードを変換 ichinose 05/12/1(木) 21:04 発言
【31914】Re:テキストファイルの改行コードを変換 ほびっと 05/12/2(金) 10:17 お礼

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