1

我真的是 VBA 的新手，我正在尝试编写一个宏，它将某些特定单元格的内容保存到我 Mac 上的特定位置。整个代码工作正常，除了它不会保存到正确的位置；所有文件保存到桌面。

基本上，A1 开始包含类似“260 - CategoryA - 555.555.555.555 - 2012-11-06 17:43:49”的内容，我希望宏将 A 列第 2-61 行的内容保存到文本以单元格 A1 中的前 3 个数字命名的文件。我希望它保存到的位置取决于单元格 A1 最初是否包含文本“CategoryA”或“CategoryB”。同样，它将数据导出到文本文件就好了，但只会保存到桌面。

任何帮助都会很棒！

Public Sub Columns_2_TextFile()

    Const My_Path1 = "Users:Username:Desktop:Folder1"
    Const My_Path2 = "Users:Username:Desktop:Folder2"
    Dim iCol As Integer
    Dim lRow As Long
    Dim File_Num As Long
    Dim SaveDest As String

    On Error Resume Next
    If InStr(1, Cells(1, 1).Value, "CategoryA", vbTextCompare) > 0 Then
        If Trim(Dir(My_Path1, vbDirectory)) = "" Then
            MkDir My_Path1
        Else
            Kill My_Path1 & "*.txt"
        End If
    ElseIf InStr(1, Cells(1, 1).Value, "CategoryB", vbTextCompare) > 0 Then
        If Trim(Dir(My_Path2, vbDirectory)) = "" Then
            MkDir My_Path2
        Else
            Kill My_Path2 & "*.txt"
        End If
    End If
    On Error GoTo 0
    File_Num = FreeFile
    With ActiveSheet
        Cells(1, 1).Value = Left(Cells(1, 1), 3)
        Open Trim(.Cells(1, 1).Value) & ".txt" For Output As #File_Num
        For lRow = 2 To 61
            Print #File_Num, .Cells(lRow, 1).Value
        Next
        Close #File_Num
    End With

End Sub
4

2 回答 2

1

我认为您遇到了这个问题，因为您没有为Open输出文件指定文件夹。我已经修改了您的代码以定义输出文件名和输出文件夹名称。

注意：您可以使用Application.PathSeperator允许通用代码在 Mac 和 Windows 上运行。

    Public Sub Columns_2_TextFile()

    Const My_Path1 = "Users:Username:Desktop:Folder1"
    Const My_Path2 = "Users:Username:Desktop:Folder2"
    Dim iCol As Integer
    Dim lRow As Long
    Dim File_Num As Long
    Dim SaveDest As String
    'Define new variables here to hold output filename and output folder
    Dim sOutFolder As String, sOutFile As String

    On Error Resume Next
    If InStr(1, Cells(1, 1).Value, "CategoryA", vbTextCompare) > 0 Then
        'Define the output folder if CategoryA here------------------
        sOutFolder = My_Path1
    ElseIf InStr(1, Cells(1, 1).Value, "CategoryB", vbTextCompare) > 0 Then
        'Define the output folder if CategoryB here-------------------
        sOutFolder = My_Path2
    End If

    'You can also make the code a bit more efficient by taking this out of the other If statement
    If Trim(Dir(My_sOutFolder, vbDirectory)) = "" Then
        MkDir My_sOutFolder
    Else
        Kill My_sOutFolder & "*.txt"
    End If

    On Error GoTo 0
    File_Num = FreeFile
    With ActiveSheet
        'Specify the output filename without destroying the original value
        sOutFile = Left(Cells(1, 1).Value, 3)
        'Specify the correct output folder and the output file name
        Open sOutFolder & Application.PathSeparator & Trim(sOutFile) & ".txt" For Output As #File_Num
        For lRow = 2 To 61
            Print #File_Num, .Cells(lRow, 1).Value
        Next
        Close #File_Num
    End With

End Sub
于 2013-03-03T09:05:46.900 回答
0

您可以将任何您想要的内容复制到新工作表并执行：

ThisWorkbook.Sheets("<new sheet name>").SaveAs Filename:=strfullpath, FileFormat:=xlText
于 2013-03-03T09:04:53.050 回答