VBA：将单元格内容保存到 Mac 上特定位置的文本文件
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/15183416/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA: save cell contents to text file in a specific location on Mac
提问by abclist19
I'm really new to VBA, and I'm trying write a macro that will save the contents of some specifc cells to a specific location on my Mac. The whole code works fine, EXCEPT that it won't save to the right location; all files save to the desktop.
我对 VBA 真的很陌生，我正在尝试编写一个宏，将某些特定单元格的内容保存到我的 Mac 上的特定位置。整个代码工作正常，除了它不会保存到正确的位置；所有文件保存到桌面。
Basically, A1 starts out containing something like this "260 - CategoryA - 555.555.555.555 - 2012-11-06 17:43:49," and I want the macro to save the contents of column A, rows 2-61 to a text file named after the first 3 numbers in cell A1. The location I want it to save to depends on whether cell A1 originally contains the text "CategoryA" or "CategoryB". Again, it export the data to a text file just fine, but will only save to the desktop.
基本上，A1 开始包含类似“260 - CategoryA - 555.555.555.555 - 2012-11-06 17:43:49”的内容，我希望宏将 A 列第 2-61 行的内容保存为文本以单元格 A1 中的前 3 个数字命名的文件。我希望它保存到的位置取决于单元格 A1 最初是否包含文本“CategoryA”或“CategoryB”。同样，它将数据导出到文本文件就好了，但只会保存到桌面。
Any help would be great!
任何帮助都会很棒！
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
采纳答案by CuberChase
I think you are having this problem since you are not specifying the folder to Openyou output file in. I've modified your code to define an output filename and an output folder name.
我认为您遇到了这个问题，因为您没有指定Open输出文件所在的文件夹。我修改了您的代码以定义输出文件名和输出文件夹名称。
Note: You can use the Application.PathSeperatorto allow common code to run on Mac and Windows.
注意：您可以使用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
回答by www
You could copy whatever you want to a new sheet and execute:
您可以将任何您想要的内容复制到新工作表并执行：
ThisWorkbook.Sheets("<new sheet name>").SaveAs Filename:=strfullpath, FileFormat:=xlText
