VBA宏將帶分隔符txt文件另存爲xls格式

  將帶分隔符txt文件另存爲xls格式

 

'功能：批量另存爲一個目錄下的XLS文件
'srcPath 源目錄
'desPath 目標目錄
'---------------------------------------
Sub SaveAsExcelInPath(srcPath As String, desPath As String)
    If Right(srcPath, 1) <> "/" Then
        srcPath = srcPath + "/"
    End If
    If Right(desPath, 1) <> "/" Then
        desPath = desPath + "/"
    End If
   
    ChDir srcPath
    Dim f_name$
    f_name = Dir(srcPath + "*.xls")       
    While f_name <> ""
        SaveAsExcel srcPath, desPath, f_name
        f_name = Dir()
    Wend
End Sub

'---------------------------------------
'功能：另存爲一個XLS文件
'srcPath 源目錄
'desPath 目標目錄
'FileName 文件名
'---------------------------------------
Sub SaveAsExcel(srcPath As String, desPath As String, FileName As String)
    If Right(srcPath, 1) <> "/" Then
        srcPath = srcPath + "/"
    End If
    If Right(desPath, 1) <> "/" Then
        desPath = desPath + "/"
    End If
   
    ChDir srcPath
        Workbooks.OpenText FileName:= _
            srcPath + FileName, _
            Origin:=936, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
            xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
            Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
            Array(2, 1)), TrailingMinusNumbers:=True
        ChDir desPath
        ActiveWorkbook.SaveAs FileName:= _
            desPath + FileName, FileFormat:= _
            xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
            , CreateBackup:=False
        ActiveWindow.Close
End Sub

'調用將c:/下的txt另存爲c:/xls目錄下，並轉換爲xls格式

SaveAsExcelInPath "C:/", _
        "C:/xls"