Определить имя файла с помощью макроса

Question

У меня есть следующий фрагмент кода для сохранения PDF-файла из существующего файла excel.

Dim FSO As Object 
Dim s(1) As String 
Dim sNewFilePath As String 

Set FSO = CreateObject("Scripting.FileSystemObject") 
s(0) = ThisWorkbook.FullName 

If FSO.FileExists(s(0)) Then 
    '//Change Excel Extension to PDF extension in FilePath 
    s(1) = FSO.GetExtensionName(s(0)) 
    If s(1) <> "" Then 
     s(1) = "." & s(1) 
     sNewFilePath = Replace(s(0), s(1), ".pdf") 

     '//Export to PDF with new File Path 
     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF,_ 
     _ Filename:=sNewFilePath, Quality:=xlQualityStandard,_ 
     _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False 
    End If 
Else 
    '//Error: file path not found 
    MsgBox "Error: this workbook may be unsaved. Please save and try again." 
End If 

Set FSO = Nothing 

Поскольку код должен выполняться рекурсивно, я хотел бы добавить к имени файла номер недели, содержащийся в данной ячейке (B2) в листе.

Я попытался заменить

s(0) = ThisWorkbook.FullName & Cells(2,2) 

, но он не работает. Где ошибка?

Answer 1

FullName Недвижимость возвращает полный путь & filename & расширение. Добавление Cells(2,2) к этому даст вам значение, подобное "c:\path\to\filename.xlsx" & Cells(2,2).Value.

Вам необходимо указать номер недели (Cells(2,2)) до расширение файла.

Вы, вероятно, может сделать это так:

sNewFilePath = Replace(s(0), s(1), Cells(2,2).Value & ".pdf") 

Или без использования FileSystemObject:

Dim fullName As String, weekNum As String 
Dim sNewFilePath As String 

weekNum = Cells(2,2).Value 
fullName = ThisWorkbook.FullName 

'If the file exists, the `Dir` function will return the filename, len != 0 
If Len(Dir(fullName)) <> 0 Then 
    'remove the extension using Mid/InstrRev functions, _ 
    build the new filename with weeknumber & pdf extension 
    sNewFilePath = Mid(fullName, 1, InstrRev(fullName,".")-1) & weekNum & ".pdf" 
    'Export to PDF with new File Path 
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF,_ 
     _ Filename:=sNewFilePath, Quality:=xlQualityStandard,_ 
     _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False 
    End If 
Else 
    '//Error: file path not found 
    MsgBox "Error: this workbook may be unsaved. Please save and try again." 
End If 

Answer 2

ПолноеИмя включает в себя расширение файла. Возможно, это (вам было бы лучше добавить ссылку на B2 также).

s(0)=split(ThisWorkbook.FullName, ".")(0) & Cells(2, 2) & ".pdf" 

Answer 3

Что-то, как это будет делать это (я прибрал ее немного):

Dim FSO As Object 
Dim s(1) As String 
Dim sNewFilePath As String 
Sub SavePDF() 

Set FSO = CreateObject("Scripting.FileSystemObject") 
s(0) = ThisWorkbook.FullName 

If FSO.FileExists(s(0)) Then 
    '//Change Excel Extension to PDF extension in FilePath 
    s(1) = FSO.GetExtensionName(s(0)) 
    If s(1) <> "" Then 
     s(1) = "." & s(1) 
     sNewFilePath = Left(s(0), InStrRev(s(0), "\")) & ".pdf" 

     '//Export to PDF with new File Path 
     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ 
     sNewFilePath & Sheets("wsTakeOff").Range("AY2").Value & " - " & Sheets("wsTakeOff").Range("D1") & ".pdf", Quality:= _ 
     xlQualityStandard, includedocproperties:=False, ignoreprintareas:=False, _ 
     openafterpublish:=False 
    End If 
Else 
    '//Error: file path not found 
    MsgBox "Error: this workbook may be unsaved. Please save and try again." 
End If 

Set FSO = Nothing 

End Sub