Question

我写了一个宏作为AddIn，以便它可以在我打开的任何工作簿中使用。此宏将自动将Excel文件另存为CSV文件。当我打开一个新的工作簿（newwb.xlsx）并应用这个AddIn时，我希望我的代码能够自动找到我保存这个newwb.xlsx的路径并将其保存在同一个位置。

我在网上发现Application.ActiveWorkbook.Path可用于定位路径本身，Application.ActiveWorkbook.FullName用于包含工作簿名称的路径。但是，它仅返回AddIn文件的路径名，而不返回newwb.xlsx的路径名。

如何获取新工作簿文件的文件路径？

这是我的代码：

'Declare the data type of the variables
Dim wks As Worksheet
Dim lastCol As Integer
Dim lastRow As Long
Dim iCol As Integer
Dim iRow As Long
Dim sFilename As String
Dim cellValue As String
Dim MyTextFile

'Set wks to the current active worksheet
Set wks = ActiveWorkbook.ActiveSheet

'Set the location of the csv file to a variable
sFilename = Application.ActiveWorkbook.FullName & "\newwb.csv"

'Within the current active worksheet, identify the last interested row and column of data
'Any values such as 'a', '1' or '%' are considered as values. Spaces (Spacebars) are not considered as values.
With wks
    With .Cells(1, 1).CurrentRegion
        lastCol = .Columns.Count
        lastRow = .Rows.Count
    End With

    'Delete extra rows with blank spaces
    For iRow = 1 To lastRow
        For iCol = 1 To lastCol
            cellValue = wks.Cells(iRow, iCol)
        Next iCol

        If Trim(cellValue) = "" Then
            wks.Cells(iRow, iCol).EntireRow.Clear
            wks.Cells(iRow, iCol).EntireColumn.Clear
        End If
    Next iRow

   'Delete extra rows and columns with formats
    .Cells(lastRow + 1, 1).Resize(Rows.Count - lastRow, 1).EntireRow.Clear
    .Cells(1, lastCol + 1).Resize(1, Columns.Count - lastCol).EntireColumn.Clear
    .UsedRange.Select
End With

'Save as .CSV file in the specific location stated earlier
'If there are errors in the code when Users presses 'No' for the conversion, set wks to nothing and end the process
On Error GoTo err_handler
wks.SaveAs Filename:=sFilename, FileFormat:=xlCSV

'System to/not display alerts to notify Users that they are replacing an existing file.
Application.DisplayAlerts = True

'Notify users that the .CSV file has been saved
MsgBox sFilename & " saved"

'Opens the CSV file in a specifc location in Notepad
MyTextFile = Shell("C:\Windows\notepad.exe ActiveWorkbook.Path & /S /K  ""\newwb.csv""", vbNormalFocus)


err_handler:
'Set Wks to its default value
Set wks = Nothing

End Sub

编辑：

Application.ActiveWorkbook.Path适用于以下行：

sFilename = Application.ActiveWorkbook.Path & "\newwb.csv"

但是有一个错误，说系统找不到此行中的路径：

MyTextFile = Shell("C:\Windows\notepad.exe Application.ActiveWorkbook.Path & /S /K  ""\newwb.csv""", vbNormalFocus)

Answer 1

从XLA使用时，

ActiveWorknook.Fullname可以正常使用。请注意您的代码

不仅使用活动工作簿的路径，而是使用附加了\ newwb.csv的活动工作簿的路径和名称

Answer 2

我已经找到了顺利运行代码的方法，方法是How do you run a .exe with parameters using vba's shell()?。希望这能帮助任何有需要的人，我要感谢那些试图帮助的人。谢谢！！

最终守则：

Option Explicit
Sub CreateCSV()

'Declare the data type of the variables
Dim wks As Worksheet
Dim lastCol As Integer
Dim lastRow As Long
Dim iCol As Integer
Dim iRow As Long
Dim sFilename As String
Dim cellValue As String
Dim MyTextFile
Dim strProgramName As String

'Set wks to the current active worksheet
Set wks = ActiveWorkbook.ActiveSheet

'Set the location of the csv file to a variable
sFilename = Application.ActiveWorkbook.Path & "\testing.csv"

'Within the current active worksheet, identify the last interested row and column of data
'Any values such as 'a', '1' or '%' are considered as values. Spaces (Spacebars) are not considered as values.
With wks
    With .Cells(1, 1).CurrentRegion
        lastCol = .Columns.Count
        lastRow = .Rows.Count
    End With

    'Delete extra rows with blank spaces
    For iRow = 1 To lastRow
        For iCol = 1 To lastCol
            cellValue = wks.Cells(iRow, iCol)
        Next iCol

        If Trim(cellValue) = "" Then
            wks.Cells(iRow, iCol).EntireRow.Clear
            wks.Cells(iRow, iCol).EntireColumn.Clear
        End If
    Next iRow

   'Delete extra rows and columns with formats
    .Cells(lastRow + 1, 1).Resize(Rows.Count - lastRow, 1).EntireRow.Clear
    .Cells(1, lastCol + 1).Resize(1, Columns.Count - lastCol).EntireColumn.Clear
    .UsedRange.Select
End With

'Save as .CSV file in the specific location stated earlier
'If there are errors in the code when Users presses 'No' for the conversion, set wks to nothing and end the process
On Error GoTo err_handler
wks.SaveAs Filename:=sFilename, FileFormat:=xlCSV

'System to/not display alerts to notify Users that they are replacing an existing file.
Application.DisplayAlerts = True

'Notify users that the .CSV file has been saved
MsgBox sFilename & " saved"

'Opens the CSV file in a specifc location in Notepad
strProgramName = "C:\Windows\notepad.exe"
MyTextFile = Shell("""" & strProgramName & """ """ & sFilename & """", vbNormalFocus)

err_handler:
'Set Wks to its default value
Set wks = Nothing

End Sub

单独工作簿的路径

编辑：

2 个答案: