Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

30165 / 76738

←次へ　｜　前へ→


	【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

0 hits

▼

【51841】ファイルの合成 ロン 07/10/7(日) 10:47