Option Explicit 'http://www.moug.net/tech/exvba/0060088.html Sub main() Dim output_folder As String Dim input_filename As String Dim target_folder As String Dim target_folder_old As String Dim target_filename As String Dim foldername_iti As Integer Dim taisyogai As Integer Dim buf As String Dim adoinput As Object Dim adooutput As Object input_filename = Cells(6, 3) output_folder = Cells(7, 3) Set adoinput = CreateObject("ADODB.Stream") Set adooutput = CreateObject("ADODB.Stream") adoinput.Charset = "utf-8" adooutput.Charset = "utf-8" '???s?R?[?h????i-1:CRLF,10:LF,CR:13) adoinput.lineseparator = -1 adooutput.lineseparator = -1 adoinput.Type = 2 '?I?u?W?F?N?g????????f?[?^?????????^??w???? adooutput.Type = 2 '?I?u?W?F?N?g????????f?[?^?????????^??w???? 'adoSt.LineSeparator = adLF adoinput.Open '????t?@?C????J?? 'Open input_filename For Input As #1 adoinput.LoadFromFile (input_filename) '?d?n?e?i?t?@?C??????j??t?@?C????I?[???????? Do While Not adoinput.EOS 'Line Input #1, buf buf = adoinput.readtext(-2) '?e?L?X?g??1?s?????? '?t?H???_?????? If InStr(buf, "?y???t?H???_?????z") <> 0 Then '?????t?H???_????????G?N?Z???t?H???_??J?n??u??????? If foldername_iti = 0 Then ' target_folder = Mid(buf, 10) foldername_iti = Len(buf) Else target_folder_old = target_folder target_folder = Mid(buf, 1 + foldername_iti) End If '?t?@?C???????? ElseIf InStr(buf, "?y???t?@?C???????z") <> 0 Then If target_filename <> "" Then 'Close #2 adooutput.SaveToFile output_folder & "\" & target_folder_old & "\" & target_filename, 2 target_folder_old = target_folder adooutput.Close End If target_filename = Mid(buf, 10) 'Open output_folder & "\" & target_filename For Output As #2 adooutput.Open '?t?@?C??????g???? Else '?^?[?Q?b?g?t?@?C??????????? 'Print #2, buf adooutput.WriteText buf '?e?L?X?g????????? End If Loop adooutput.SaveToFile output_folder & "\" & target_folder_old & "\" & target_filename, 2 adoinput.Close adooutput.Close End Sub