VBA excel文件xls批量转换为xlsx,文件移动,文件删除


'***********访问当前文件夹下所有子文件夹及文件,
Dim iFile(1 To 100000) As String
Dim count As Integer
Public k As Integer

Sub CommandButton1_Click()
 iPath = ThisWorkbook.Path
 On Error Resume Next
 count = 0
 k = 0
 Sheet1.Cells(3, 5) = k
 Sheet1.Cells(6, 5) = ""
 zdir iPath
 For i = 1 To count
 If iFile(i) Like "*.xls" And iFile(i) <> ThisWorkbook.FullName Then
    MyFile = iFile(i)
    FilePath = Replace(MyFile, ".xls", ".xlsx")
    If Dir(FilePath, 16) = Empty Then
        Set WBookOther = Workbooks.Open(MyFile)
        Application.ScreenUpdating = False
        ActiveWorkbook.SaveAs Filename:=FilePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        WBookOther.Close SaveChanges:=False '解决不能close 文件问题
        Application.ScreenUpdating = True
        k = k + 1
        Sheet1.Cells(3, 5) = k
        Sheet1.Cells(6, 5) = MyFile
        DoEvents
    End If
 End If
 Next
 MsgBox ("--转换完成--")
End Sub
Sub zdir(p) '访问当前文件夹下所有子文件夹及文件
 Set fs = CreateObject("scripting.filesystemobject")
 For Each f In fs.GetFolder(p).Files
 If f <> ThisWorkbook.FullName Then count = count + 1: iFile(count) = f
 Next
 For Each m In fs.GetFolder(p).SubFolders
 zdir m
 Next
End Sub

Private Sub 开始删除xls文件_Click()
 iPath = ThisWorkbook.Path
 On Error Resume Next
 count = 0
 k = 0
 Sheet1.Cells(3, 5) = k
 Sheet1.Cells(6, 5) = ""
 zdir iPath
 For i = 1 To count
 If iFile(i) Like "*.xls" And iFile(i) <> ThisWorkbook.FullName Then
    MyFile = iFile(i)
    FilePath = Replace(MyFile, ".xls", ".xlsx")
    If Dir(FilePath, 16) <> Empty Then
        Kill MyFile
        k = k + 1
        Sheet1.Cells(3, 5) = k
        Sheet1.Cells(6, 5) = MyFile
        DoEvents
    End If
 End If
 Next
 MsgBox ("--删除完成--")
End Sub

Private Sub 移动xls文件_Click()
 iPath = ThisWorkbook.Path
 Dim oFso As Object
 On Error Resume Next
 count = 0
 k = 0
 Sheet1.Cells(3, 5) = k
 Sheet1.Cells(6, 5) = ""
 
Dim strFolder As String
  '差异:msoFileDialogFolderPicker
 With Application.FileDialog(msoFileDialogFolderPicker)
     .Title = "选择目标文件夹"
     .InitialFileName = ThisWorkbook.Path
     If .Show Then
         strFolder = .SelectedItems(1)
     End If
 End With
 
 Sheet1.Cells(14, 5) = strFolder
 
 If strFolder = "" Then
    MsgBox ("--程序终止--")
    Exit Sub
 End If
 

 
 zdir iPath
 Set oFso = CreateObject("Scripting.FileSystemObject")
 For i = 1 To count
 If iFile(i) Like "*.xls" And iFile(i) <> ThisWorkbook.FullName Then
    MyFile = iFile(i)
    FilePath = Replace(MyFile, ".xls", ".xlsx")
    Filename = Dir(MyFile, 16)
    If Dir(FilePath, 16) <> Empty Then
        oFso.movefile MyFile, strFolder + "\" + Filename
        k = k + 1
        Sheet1.Cells(3, 5) = k
        Sheet1.Cells(6, 5) = MyFile
        DoEvents
    End If
 End If
 Next
 MsgBox ("--移动完成--")
End Sub

界面:

 

  • 1
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
你可以使用openpyxl库将xls文件转换xlsx文件。下面是一个示例代码: ```python import openpyxl from openpyxl.utils import get_column_letter from openpyxl import Workbook from openpyxl.compat import range def convert_xls_to_xlsx(xls_file, xlsx_file): # 打开xls文件 xls_workbook = openpyxl.load_workbook(xls_file, read_only=True, keep_vba=False, data_only=True) # 创建新的xlsx文件 xlsx_workbook = Workbook() # 遍历xls文件中的每个工作表 for sheet_name in xls_workbook.sheetnames: xls_sheet = xls_workbook[sheet_name] xlsx_sheet = xlsx_workbook.create_sheet(title=sheet_name) # 复制每个单元格的值和样式到新的xlsx文件中 for row in xls_sheet.iter_rows(): for cell in row: xlsx_sheet[cell.coordinate].value = cell.value if cell.has_style: xlsx_sheet[cell.coordinate].font = cell.font xlsx_sheet[cell.coordinate].border = cell.border xlsx_sheet[cell.coordinate].fill = cell.fill xlsx_sheet[cell.coordinate].number_format = cell.number_format xlsx_sheet[cell.coordinate].alignment = cell.alignment # 调整列宽 for column_cells in xls_sheet.columns: max_length = 0 column = column_cells[0].column_letter for cell in column_cells: try: if len(str(cell.value)) > max_length: max_length = len(cell.value) except: pass adjusted_width = (max_length + 2) * 1.2 xlsx_sheet.column_dimensions[column].width = adjusted_width # 删除默认创建的空白工作表 del xlsx_workbook["Sheet"] # 保存xlsx文件 xlsx_workbook.save(xlsx_file) # 示例用法 xls_file = "example.xls" xlsx_file = "example.xlsx" convert_xls_to_xlsx(xls_file, xlsx_file) ``` 在示例中,我们首先使用`openpyxl.load_workbook()`函数打开xls文件,然后使用`openpyxl.Workbook()`创建一个新的xlsx文件。接下来,我们遍历xls文件中的每个工作表,并将每个单元格的值和样式复制到新的xlsx文件中。最后,我们调整每列的宽度,并删除默认创建的空白工作表。最后,我们使用`xlsx_workbook.save()`函数保存xlsx文件。 确保在运行代码之前安装openpyxl库,可以使用以下命令进行安装: ``` pip install openpyxl ``` 请将`xls_file`和`xlsx_file`变量替换为你实际的文件路径。
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值