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 に答える