文件格式转换VBA

在工作过程中有时会需要对数据进行格式转换，如TXT，xlsx，xls之间的相互转换，有很多方法来实现，这里主要记录利用Excel中VBA。
（1）在需要转换数据的文件夹下新建Excel，打开VBA；
（2）将代码复制过去，执行即可。

1.txt2xlsx

Sub Convert2Xlsx()
On Error Resume Next
Application.ScreenUpdating = False
Dim fPath$, mPath$, WB As Workbook, arr, s
mPath = ThisWorkbook.Path: fPath = Dir(mPath & "*.txt")
Application.Displayalerts = False
Do Until fPath = ""
    Open mPath & "" & fPath For Input As #1
        s = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
    Close #1
        Set WB = Workbooks.Add
        With WB
            For a = 0 To UBound(s)
                arr = Split(s(a), ",")
                .Sheets(1).Cells(a + 1, 1).Resize(, UBound(arr) + 1) = arr
            Next
            .SaveAs mPath & "" & Split(UCase(fPath), ".TXT")(0), xlWorkbookDefault
            .Close
        End With
        fPath = Dir
Loop
Application.Displayalerts = True
Application.ScreenUpdating = True
MsgBox "KO"
End Sub

利用python openpyxl模块来实现：

import os

import  openpyxl

txtPath = 'txt file path/'

# txtPath = txtPath.encode('utf-8')

txtType = 'txt'

txtLists = os.listdir(txtPath)

print(txtLists)

for txt in txtLists:
    
    f = open(txtPath+txt,encoding='utf-8')  
    
    lines = f.readlines()
    
    file = openpyxl.Workbook()
    
    worksheet = file.active
    
    i = 1
    
    # print(txt)
    
    for line in lines:
        
        line = line.strip('n')
        
        worksheet.cell(i, 1,float(str( line)))
        
        i = i + 1
        
        file.save('save path /'+ txt.split('.')[0] +'.xlsx')
        
print('done!')

2.csv2xls

ChDir "path to file"

Dim sDir As String

Dim curdir As String

curdir = "path to file"

sDir = Dir(curdir & "*.csv")

While Len(sDir)

Workbooks.Open Filename:=curdir & "" & sDir

Dim temp As String

temp = Left(sDir, Len(sDir) - 4)

ActiveWorkbook.SaveAs Filename:=curdir & "" & temp & ".xls", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

ActiveWorkbook.Close

sDir = Dir

3.xls2xlsx

Sub xls2xlsx()
Dim FilePath, MyFile, iPath, Name, OutPath As String
iPath = ThisWorkbook.Path
OutPath = Dir(iPath & "xlsx", vbDirectory)
If OutPath = "" Then
    MkDir (iPath & "xlsx")
End If
MyFile = Dir(iPath & "*.xls")

If MyFile <> "" Then
Do
    On Error Resume Next
    If MyFile = ThisWorkbook.Name Then MyFile = Dir
    Workbooks.Open (iPath & "" & MyFile)
    MyFile = Replace(MyFile, ".xls", ".xlsx")
    Name = "" & MyFile
    FilePath = iPath & "xlsx" & Name
    Application.ScreenUpdating = False
    ActiveWorkbook.SaveAs Filename:=FilePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Workbooks(MyFile).Close True
    Application.ScreenUpdating = True
    MyFile = Dir
Loop While MyFile <> ""
End If
End Sub