请大侠帮忙写一个vba代码

yanziyang223

请大侠帮忙写一个vba代码，清除文件夹下所有工作簿里面的代码
文件太多，一个个去清理太麻烦了，请高手出手帮忙一下，能把文件夹下所有工作簿里的所有代码清除并保存，万分感谢！！！！！！！

perfect131

另存为xlsx

yanziyang223

perfect131 发表于 2024-12-21 17:56
另存为xlsx

文件有成百上千个个，只能发到各个文件夹下去运行清除文件夹内所有的工作表，几个工作簿的话，手工另存为一下，就搞定了，关键太多了

micch

会写代码，就遍历文件打开另存就可以了吧

yanziyang223

micch 发表于 2024-12-21 19:01
会写代码，就遍历文件打开另存就可以了吧

会写的话，就是写直接清除的代码了，就是不会啊

opiona

2楼正解:
遍历文件
打开后 另存为xlsx

micch

yanziyang223 发表于 2024-12-21 19:12
会写的话，就是写直接清除的代码了，就是不会啊

遍历的代码论坛一大堆，随便找一个，每个文件执行操作

举例：
for each 文件路径 in 文件集合
set wb = workbooks.open(文件路径)
wb.savecopyas 文件新路径
wb.close false
next

yanziyang223

opiona 发表于 2024-12-21 19:27
2楼正解:
遍历文件
打开后 另存为xlsx

Sub RemoveVBACodeFromAllWorkbooksInCurrentFolder()
    Dim folderPath As String
    Dim fileName As String
    Dim wb As Workbook
    Dim vbComp As Object

    ' 获取当前文件夹路径
    folderPath = ThisWorkbook.Path & "\"

    ' 获取第一个Excel文件
    fileName = Dir(folderPath & "*.xls*")

    ' 遍历文件夹中的所有Excel文件
    Do While fileName <> ""
        ' 打开工作簿
        Set wb = Workbooks.Open(folderPath & fileName)

        ' 检查是否有VBA项目
        On Error Resume Next
        Set vbComp = wb.VBProject.VBComponents
        On Error GoTo 0

        If Not vbComp Is Nothing Then
            ' 删除所有VBA组件
            For Each comp In vbComp
                wb.VBProject.VBComponents.Remove comp
            Next comp
        End If

        ' 保存并关闭工作簿
        wb.Close SaveChanges:=True

        ' 获取下一个Excel文件
        fileName = Dir
    Loop

    MsgBox "当前文件夹中所有工作簿中的VBA代码已清除完毕！"
End Sub



这个代码就是清楚不了，有什么问题，请告诉解决一下

木槿花西月锦绣

百度智能回答就有代码，可以用，楼主根据自己的需要改一改就行


Sub Main()
    Dim folderPath As String
    Dim fileName As String
    Dim newFileName As String
    Dim wb As Workbook
   
    ' 设置当前工作簿所在的文件夹路径
    folderPath = ThisWorkbook.Path & "\"
   
    ' 遍历文件夹中的每个文件
    fileName = Dir(folderPath & "*.xlsm")
    Do While fileName <> ""
        ' 打开xlsm文件
        Set wb = Workbooks.Open(folderPath & fileName)
        
        ' 生成新的文件名并更改扩展名为xlsx
        newFileName = Replace(fileName, ".xlsm", ".xlsx")
        
        ' 另存为xlsx文件
        wb.SaveAs Filename:=folderPath & newFileName, FileFormat:=xlOpenXMLWorkbook
        
        ' 关闭打开的工作簿
        wb.Close SaveChanges:=False
        
        ' 获取下一个xlsm文件名
        fileName = Dir
    Loop
   
    MsgBox "所有xlsm文件已转换为xlsx。", vbInformation
End Sub

yanziyang223

木槿花西月锦绣 发表于 2024-12-21 20:05
百度智能回答就有代码，可以用，楼主根据自己的需要改一改就行

我用了10个ai平台的代码，测试都不能清除代码，又不知道怎么修改