Excel VBA質問箱 IV

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

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


30159 / 76732 ←次へ | 前へ→

【51842】Re:ファイルの合成
回答  Hirofumi  - 07/10/7(日) 12:03 -

引用なし
パスワード
   Testしていないので上手くいかなかったらごめん?
ファイルサイズが小さいなら、多分、こんなでも出来るかも?
ファイルサイズが大きい場合は少し工夫が必要かも?

Option Explicit

Public Sub Sample()

  Dim i As Long
  Dim vntMerge As Variant
  Dim vntOutput As Variant
  Dim strBuff As String
  Dim dfi As Integer
  Dim dfo As Integer
  Dim lngSize As Long
  Dim strProm As String
  
  vntMerge = Array("AAA", "BBB")
  
  '連結するファイルを選択
  For i = 0 To 1
    If Not GetReadFile(vntMerge(i), ThisWorkbook.Path, False) Then
      strProm = "処理がキャンセルされました"
      GoTo Wayout
    End If
  Next i
  
  '出力するファイル名を指定
  vntOutput = "CCC"
  If Not GetWriteFile(vntOutput, ThisWorkbook.Path) Then
    strProm = "処理がキャンセルされました"
    GoTo Wayout
  End If
  'もし、出力ファイルが既に存在するなら削除
  If Dir(vntOutput) <> "" Then
    Kill vntOutput
  End If
  
  '出力ファイルをOpen
  dfo = FreeFile
  Open vntOutput For Binary As dfo
  
  'マージ処理
  For i = 0 To 1
    '連結するファイルOpen
    dfi = FreeFile
    Open vntMerge(i) For Binary As dfi
      'ファイルサイズを取得
      lngSize = LOF(dfi)
      'ファイルを変数に読み込み
      strBuff = Input(lngSize, dfi)
      '変数の値を出力
      Put #dfo, , strBuff
    Close dfi
  Next i
  
  '出力ファイルをClose
  Close dfo
  
  strProm = "処理が完了しました"
  
Wayout:

  MsgBox strProm, vbInformation
  
End Sub

Private Function GetReadFile(vntFileNames As Variant, _
            Optional strFilePath As String, _
            Optional blnMultiSel As Boolean _
                    = False) As Boolean

  Dim strFilter As String
  
  'フィルタ文字列を作成
  strFilter = "Text File (*.txt),*.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, 2, , , blnMultiSel)
  If VarType(vntFileNames) = vbBoolean Then
    Exit Function
  End If
  
  GetReadFile = True
  
End Function

Private Function GetWriteFile(vntFileName As Variant, _
            Optional strFilePath As String) As Boolean

  Dim strFilter As String
  Dim strInitialFile As String
  
  'フィルタ文字列を作成
  strFilter = "Text File (*.txt),*.txt," _
          & "全て (*.*),*.*"
  '既定値のファイル名を設定
  strInitialFile = vntFileName
  '読み込むファイルの有るフォルダを指定
  If strFilePath <> "" Then
    'ファイルを開くダイアログ表示ホルダに移動
    ChDrive Left(strFilePath, 1)
    ChDir strFilePath
  End If
  '「ファイルを保存」ダイアログを表示
  vntFileName _
    = Application.GetSaveAsFilename(vntFileName, strFilter, 2)
  If vntFileName = False Then
    Exit Function
  End If

  GetWriteFile = True
  
End Function
1 hits

【51841】ファイルの合成 ロン 07/10/7(日) 10:47 質問
【51842】Re:ファイルの合成 Hirofumi 07/10/7(日) 12:03 回答
【51848】Re:ファイルの合成 Hirofumi 07/10/7(日) 13:13 回答
【51849】Re:ファイルの合成 ロン 07/10/7(日) 13:38 お礼
【51843】Re:ファイルの合成 りん 07/10/7(日) 12:27 回答
【51850】Re:ファイルの合成 ロン 07/10/7(日) 13:49 発言
【51851】Re:ファイルの合成 りん 07/10/7(日) 13:52 発言
【51852】Re:ファイルの合成 ロン 07/10/7(日) 13:59 発言
【51890】Re:ファイルの合成 ロン 07/10/9(火) 19:46 お礼
【51894】Re:ファイルの合成 りん 07/10/9(火) 20:48 発言
【51862】コピーの進捗状況 ロン 07/10/8(月) 17:15 質問

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