转换为xcl / txt后尝试将文件另存为.001类型的文件

时间:2018-09-08 14:30:28

标签: vba

我正在VBA中编写代码,该代码应收集文件.001类型,并将其转换为Excel文件(以空格分隔)。然后,我需要将其拆分为不同的文件(N个步骤),然后将其转换回.001文件(如原始文件)。但是我无法复制原始的.001格式。我可以附加原始文件吗?有没有其他方法可以将.001文件拆分为N个不同的.001文件?

Sub Import_file()

Dim MFC_name As String

Sheet1.Cells.ClearContents
Range("A1").Select
file_path = Application.GetOpenFilename()

    Workbooks.OpenText filename:=file_path, Origin:=437 _
        , StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
    Columns("A:G").Select
    Selection.Copy
    Windows("code_test.xlsm").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Application.CutCopyMode = False
    ActiveWindow.ActivateNext
    MFC_name = ActiveWorkbook.Name
    Application.DisplayAlerts = False
    ActiveWindow.Close
    Range("I1").Value = MFC_name
    Range("A1").Select
End Sub



Sub split_and_write()

Dim totalRows As Long
Dim newBook As Workbook
Dim curRow As Long
Dim filename As Variant
Dim lastRow As Long
Dim path As String
Dim myFileName As String
Dim r As Integer




totalRows = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

For curRow = 8 To totalRows Step 1244
    Set newBook = Workbooks.Add


    With ThisWorkbook.Sheets("Sheet1")

    'copy of the 7 rows with name+tool number+time and paste it to new workbook
        ThisWorkbook.Worksheets("Sheet1").Range("A1:B7").Copy newBook.Sheets("Sheet1").Range("A1")

    'copy and creation of the seperate workboks
       .Rows(curRow & ":" & curRow + 1243).EntireRow.Copy newBook.Sheets("Sheet1").Range("A8")


      'copy xcl to txt for each workbook
       lastRow = newBook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

      'creation of .txt file path
       path = "C:\XCL_FP\MFC_flow_cal\MFC_test\"
       myFileName = InputBox("name?")
       myFileName = myFileName & ".001"   'Providing extantion for the file
       myFileName = path & myFileName

      'writhing .xcl file to.001
       Open myFileName For Output As #1
            For r = 1 To lastRow
                Print #1, Range("A" & r); " "; Range("B" & r)
            Next r
       Close #1

        Application.DisplayAlerts = False
        ActiveWorkbook.Close SaveChanges:=False
        Application.DisplayAlerts = True

        'filename = Application.GetSaveAsFilename

        'newBook.saveas filename:=filename

    End With

Next curRow

End Sub

0 个答案:

没有答案