| |
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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 07/10/7(日) 12:27 -
