CODEWITHSUNDEEP
excelvbamacostext-files
abclist19
abclist19

Reputation: 363

VBA: save cell contents to text file in a specific location on Mac

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.

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.

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

Upvotes: 1

Views: 8546

Answers (2)

CuberChase
CuberChase

Reputation: 4518

I think you are having this problem since you are not specifying the folder to Open you output file in. I've modified your code to define an output filename and an output folder name.

Note: You can use the Application.PathSeperator to allow common code to run on Mac and 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

Upvotes: 1

www
www

Reputation: 4391

You could copy whatever you want to a new sheet and execute:

ThisWorkbook.Sheets("<new sheet name>").SaveAs Filename:=strfullpath, FileFormat:=xlText

Upvotes: 0

Related Questions