ギリギリでフロッピーディスクに入らないときって悔しいよね。
分割されて作成されるファイルの拡張子は、dv01、dv02、dv03… というように、dv + ファイルのインデックス2桁にする。この場合、99個までしか分割できないけど、そこら辺は自分で改造するなりして補ってください。またここでは、必要最低限の実装のみでエラー処理は省略しています。この点は了承をば。
'------------------------------------------------------------------- ' 関数名 : GetCurrentDir ' 機能 : カレントディレクトリを取得する ' 引数 : なし ' 返り値 : カレントディレクトリが返る '------------------------------------------------------------------- Private Function GetCurrentDir() As String Dim FilePath As String FilePath = App.Path If Right$(FilePath, 1) <> "\" Then FilePath = FilePath & "\" GetCurrentDir = FilePath End Function '------------------------------------------------------------------- ' 関数名 : ExecuteDivFile ' 機能 : ファイルを分割する ' 引数 : (in) FilePath … 分割対象ファイルのフルパス ' (in) MKFileName … 分割作成されるファイルの名前 ' (in) DivSizeID … 0:フロッピーディスク分割(1450000Byte) ' 1:100000Byte 2:50000Byte ' 返り値 : なし '------------------------------------------------------------------- Public Sub ExecuteDivFile(ByVal FilePath As String, ByVal MKFileName As String, ByVal DivSizeID As Long) Dim BaseFilePath As String '分割対象となるファイルのフルパス Dim BaseFileSize As Long '分割対象となるファイルのサイズ Dim BinFileData() As Byte '分割対象となるファイルを読み込むためのバッファ Dim i As String '作業用変数 Dim ROOPMAX As String 'For分でループするときの最大値 Dim FileNumber01 As String 'ファイルナンバー Dim FileNumber02 As String 'ファイルナンバー Dim ReadFileData As Long '分割するサイズを格納するバッファサイズ Dim DivFileSize As Long 'ファイル分割サイズ '分割対象となるファイルのフルパスをセット BaseFilePath = FilePath '分割対象となるファイルのサイズをセット BaseFileSize = FileLen(BaseFilePath) '分割対象ファイルのサイズが指定サイズより小さい場合 If BaseFileSize <= DivFileSize Then Call MsgBox("ファイルを分割する必要がありません", vbOKOnly + vbInformation, "ファイル分割 - エラー") Exit Sub End If 'ファイル分割サイズを設定 Select Case DivSizeID Case 0 DivFileSize = 1450000 Case 1 DivFileSize = 100000 Case 2 DivFileSize = 50000 Case Else Call MsgBox("第3引数が不正です", vbOKOnly + vbExclamation, "ファイル分割 - エラー") Exit Sub End Select 'For分でループするときの最大値を求める ROOPMAX = BaseFileSize \ DivFileSize '分割対象となるファイルのサイズを指定分割サイズで割ったとき '余りがあるなら、ループ最大カウンタを1つ追加する If BaseFileSize Mod DivFileSize <> 0 Then ROOPMAX = ROOPMAX + 1 End If 'ファイルナンバーを割り当てる FileNumber01 = FreeFile '分割対象ファイルを開く Open FilePath For Binary Access Read As #FileNumber01 For i = 1 To ROOPMAX '読みこむファイルサイズ分を初期化した後に確保 Erase BinFileData If i = ROOPMAX Then ReadFileData = FileLen(BaseFilePath) - (DivFileSize * (i - 1)) Else ReadFileData = DivFileSize End If 'メモリ再確保 ReDim Preserve BinFileData(ReadFileData - 1) As Byte '読みこみ位置を指定 Seek #FileNumber01, 1 + (DivFileSize * (i - 1)) Get #FileNumber01, , BinFileData() '読みこみ 'ファイルナンバーを割り当てる FileNumber02 = FreeFile Open GetCurrentDir & MKFileName & Chr$(46) & "dv" & Format$(CStr(i), "00") _ For Binary Access Write As #FileNumber02 Put #FileNumber02, , BinFileData() '書きこみ Close #FileNumber02 Next i Close #FileNumber01 End Sub '------------------------------------------------------------------- ' 関数名 : ExecuteDockFile ' 機能 : 分割ファイルを結合する ' 引数 : (in) FilePath … 1つ目(拡張子dv01)の分割対象ファイルのフルパス ' (in) MKFileName … 結合されて作成されるファイルの名前 ' 返り値 : なし ' 備考 :メモリーエラーに注意 '------------------------------------------------------------------- Public Sub ExecuteDockFile(ByVal FilePath As String, ByVal MKFileName As String) Dim FileNumber01 As Integer 'ファイルナンバー Dim FileNumber02 As Integer 'ファイルナンバー Dim BinFileData() As Byte '分割ファイルから読み込んだデータを格納するバッファ Dim GetFileName As String '1つ目(拡張子dv01)の分割ファイル名 Dim tgFileName As String '読み込むための分割ファイル名 Dim GetFileDir As String '1つ目(拡張子dv01)の分割ファイルのあるディレクトリ Dim i As Integer '作業用変数 '1つ目(拡張子dv01)の分割対象ファイルのフルパスからファイル名を得る GetFileName = Dir$(FilePath) '結合対象ファイルの拡張子の数字部分を除いたファイル名を得る GetFileName = Left$(GetFileName, Len(GetFileName) - 2) '1つ目(拡張子dv01)の分割対象ファイルのあるディレクトリを得る GetFileDir = Left$(FilePath, Len(FilePath) - Len(GetFileName) - 2) 'ファイルナンバーを割り当てる FileNumber02 = FreeFile Open GetFileDir & MKFileName For Binary Access Write As #FileNumber02 For i = 1 To 99 tgFileName = GetFileDir & GetFileName & Format$(CStr(i), "00") 'ファイルが見つからなければループを抜ける If Dir$(tgFileName) = "" Then Exit For FileNumber01 = FreeFile 'ファイルナンバーを割り当てる '分割対象ファイルを開く Open tgFileName For Binary Access Read As #FileNumber01 Erase BinFileData '初期化 ReDim Preserve BinFileData(FileLen(tgFileName) - 1) As Byte 'ファイルサイズ分バッファを確保 Get #FileNumber01, , BinFileData() '読みこみ Put #FileNumber02, , BinFileData() '書きこみ Close #FileNumber01 Next i Close #FileNumber02 End Sub 以上で終わり。使用上制限がある部分は改造してより良いものを作ってみてちょ。 |