如何正确使用Worksheets.SaveAs函数解决VBA导出TXT报错问题

错误根因梳理 #

• 运行时错误438：核心原因是Range对象没有SaveAs方法，只有工作表对象支持该方法；其次你新建工作表时把变量actSheet加了引号，变成查找名为"actSheet"的固定工作表，找不到就会报错。
• 运行时错误1004：一是获取行数时未指定工作表，默认取当前激活表的行号，区域拼接非法；二是未判断用户是否选中导出文件夹，路径为空导致导出失败；三是工作表名赋值逻辑错误，循环时不会更新名称，导致工作表/路径异常。

修正后完整代码 #

首先补充你代码缺失的工作表存在校验函数，再调整主流程逻辑：

Option Explicit ' 强制变量声明

' 校验工作表是否存在的工具函数
Function DoesSheetExists(sheetName As String) As Boolean
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets(sheetName)
    On Error GoTo 0
    DoesSheetExists = Not ws Is Nothing
End Function

Sub test_wh()    
    Dim exportFolder As String
    Dim fd As FileDialog
   
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    
    With fd
        .Title = "选择导出wh和wg文件的文件夹"
        If .Show <> True Then
            ' 用户点了取消直接退出
            Set fd = Nothing
            Exit Sub
        End If
        exportFolder = .SelectedItems(1)
    End With
    Set fd = Nothing

    Dim nameSheet As String
    Const baseSheet As String = "BASE"
    Dim actSheet As String
    Dim f As Integer
    Dim i As Integer
        
    actSheet = ActiveSheet.Name
    
    i = 30
    f = 0

    Do While i < 361
        ' 修正工作表名赋值逻辑，保证i<100时补0，名称统一为5位
        If i < 100 Then
            nameSheet = "wh0" & i
        Else
            nameSheet = "wh" & i
        End If

        If DoesSheetExists(nameSheet) Then
            Worksheets(nameSheet).Range("A1:B27").ClearContents
        Else
            ' 修正新建工作表的参数，去掉actSheet的引号
            Sheets.Add(After:=Sheets(actSheet)).Name = nameSheet
        End If
        
        ' 统一写数据逻辑，避免重复代码
        Worksheets(baseSheet).Range("AP22").Offset(f, 0).Resize(27, 1).Copy
        Worksheets(nameSheet).Range("A1:A27").PasteSpecial xlPasteValues
        Worksheets(baseSheet).Range("AQ22").Offset(f, 0).Resize(27, 1).Copy
        Worksheets(nameSheet).Range("B1:B27").PasteSpecial xlPasteValues
        ' 清空剪贴板
        Application.CutCopyMode = False

        ' 导出为txt文件逻辑修正：用临时工作表实现指定区域导出，不影响原表
        Dim tempWs As Worksheet
        Dim lRow As Long
        Dim exportPath As String
        
        ' 指定在nameSheet里获取最后一行
        lRow = Worksheets(nameSheet).Cells(Rows.Count, 2).End(xlUp).Row
        exportPath = exportFolder & "\" & nameSheet & ".txt"
        
        ' 新建临时表复制需要导出的区域
        Set tempWs = ThisWorkbook.Sheets.Add
        Worksheets(nameSheet).Range("A1:B" & lRow).Copy tempWs.Range("A1")
        ' 保存临时表为txt
        tempWs.SaveAs Filename:=exportPath, FileFormat:=xlText, CreateBackup:=False
        ' 关闭临时表不提示保存
        Application.DisplayAlerts = False
        tempWs.Delete
        Application.DisplayAlerts = True

        i = i + 30
        f = f + 1
    Loop

    'Call wg_test
    MsgBox "导出完成！", vbInformation
End Sub

额外注意事项 #

• 导出区域如果需要固定为A1:B27，可去掉lRow判断，直接写死区域即可
• 若不需要保留生成的wh开头的工作表，可在导出完成后自行添加删除逻辑
• 导出的txt默认是制表符分隔的文本格式，符合常规使用需求

内容的提问来源于stack exchange，提问作者Pieter725