单独的工作簿的path

我写了一个macros作为一个AddIn,以便它可以在我打开的任何工作簿中使用。 这个macros会自动将Excel文件保存为CSV文件。 当我打开一个新的工作簿(newwb.xlsx)并应用这个AddIn时,我想让我的代码自动find保存这个newwb.xlsx的path,并将它保存在同一个位置。

我在网上findApplication.ActiveWorkbook.Path可以用来定位path本身和Application.ActiveWorkbook.FullName与工作簿名称的path。 但是,它只返回AddIn文件的path名,而不是newwb.xlsx的path名。

如何获取新工作簿文件的文件path?

这是我的代码:

 '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" 

但有一个错误,说系统找不到这一行的path:

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

当从XLA中使用ActiveWorknook.Fullname对我来说工作正常。 请注意,你的代码

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

不只是使用活动工作簿的path,而是使用\ newwb.csv附加的活动工作簿的path和名称

我已经find了顺利运行代码的方式,在礼貌您如何使用vba的shell()参数运行.exe? 。 希望这会帮助有需要的人,我也要感谢那些试图帮助的人。 谢谢!!

最终代码:

 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