MsgBox which shows path saved file- VBA

[cams88]

Hello,

I need help with my macro. I want to create MsgBox which shows file path saved file.

This is my macro which saves file (It works):
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\FileVBA.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False

And this is my macro which should show file path (it doesn't work):

Loc = ThisWorkbook.Path & "\FileVBA.pdf"
MsgBox Loc

 

[Joe4]

How does it not work?
What does it return?

I usually use "ActiveWorkbook" instead of "ThisWorkbook". You can try it, but I don't that it will make a difference.

Please also post the entirety of your code, so we can see when and how you are using it within your code.

 

[cams88]

How does it not work?
What does it return?

I usually use "ActiveWorkbook" instead of "ThisWorkbook". You can try it, but I don't that it will make a difference.

Please also post the entirety of your code, so we can see when and how you are using it within your code.

It returns this window:

 

[Joe4]

Please post your entire block of VBA code containging this portion.

 

[cams88]

It returns this window:

View attachment 9658

My entirety code is very long because i do many things in my file, but i have problem only with end of it when i'm trying to do msgbox.

this is last part of my code:

' Print area

Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 300
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 0
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True

' Saving to PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\FileVBA.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False

' Getting file Path
Loc = ThisWorkbook.Path & "\FileVBA.pdf"
MsgBox Loc

'Screen updating should be activated
'Application.ScreenUpdating = True
End Sub

 

[cams88]

Sub Myfile ()

Dim wrk As Workbook 'Workbook object - Always good to work with object variables
Dim Instrukcja As Workbook
Dim sht As Worksheet 'Object for handling worksheets in loop
Dim TabelaZ As Worksheet 'Master Worksheet- tabela zbiorcza (trg)
Dim rng As Range 'Range object
Dim colCount As Integer 'Column count in tables in the worksheets

Set wrk = ActiveWorkbook 'Working in active workbook

'For Each sht In wrk.Worksheets
' If sht.Name = "Master" Then
' MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _
' "Please remove or rename this worksheet since 'Master' would be" & _
' "the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error"
' Exit Sub
' End If
' Next sht

'We don't want screen updating
'Application.ScreenUpdating = False

'Add new worksheet as the last worksheet
Set TabelaZ = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
'Rename the new worksheet
TabelaZ.Name = "Tabela zbiorcza"
'Get column headers from the first worksheet
'Column count first
Set sht = wrk.Worksheets(2)
colCount = sht.Cells(1, 255).End(xlToLeft).Column
'Now retrieve headers, no copy&paste needed
With TabelaZ.Cells(1, 1).Resize(1, colCount)
.Value = sht.Cells(1, 1).Resize(1, colCount).Value
'Set font as bold
.Font.Bold = True
End With

'We can start loop
For Each sht In wrk.Worksheets
'If worksheet in loop is the last one, stop execution (it is Master worksheet)
If sht.Index = wrk.Worksheets.Count And sht.Name <> "Instrukacja" Then
Exit For
End If
'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
'Put data into the Master worksheet
TabelaZ.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
Next sht
'Fit the columns in Master worksheet
TabelaZ.Columns.AutoFit

' Zmiana nazw samochodów
Dim Zmienna As Range
Dim CS As Range 'Ciągnik Samochodowy -> Ciągnik Siodłow
Dim SC As Range 'Samochód Specjalny -> Samochód Ciężarowy


Zakres = WorksheetFunction.CountA(Range("B2", Range("B2").End(xlDown)))

Set Zmienna = Range(Cells(2, 2), Cells(Zakres, 2))

For Each CS In Zmienna.Cells
CS = Replace(CS, "Ciągnik Samochodowy", "Ciągnik Siodłowy")

Next

For Each SC In Zmienna.Cells
SC = Replace(SC, "Samochód Specjalny", "Samochód Ciężarowy")

Next


' Przyporządkowanie do kategorii wagowej

Dim cell610 As Range
Dim cell1016 As Range


For Each cell610 In Range("F2:F921")
If cell610.Value < 10000 Then
cell610.Value = "6-10t."

End If
Next

For Each cell1016 In Range("F2:F921")
If cell1016.Value >= 10000 And cell1016.Value < 16000 Then
cell1016.Value = "10-16t."

End If
Next

' Zamiana pustych komórek w kolumnie E na "Bd."
Dim Puste As Range

For Each Puste In Range("e2:e921")
If Puste.Value = "" Then
Puste.Value = "Bd."

End If
Next


' Zamiana wartości "Ciągnik siodłowy" oraz waga >16000 na "Artics"

Dim Artics As Range
Range("k2:k921").FormulaR1C1 = _
"=IF(AND(RC[-9]=""Ciągnik Siodłowy"",RC[-5]>16000),""Artics"")"

Dim ArticsA As Range
For Each ArticsA In Range("K2:K921")
If ArticsA.Value = "Artics" Then ArticsA.Offset(, -5).Value = "Artics"
Next ArticsA

' Zamiana warości "Samochód ciężarowy" oraz waga >16000 na "Rigids"

Dim Rigids As Range
Range("L2:L921").FormulaR1C1 = _
"=IF(ISNUMBER(RC[-6])=TRUE,IF(AND(RC[-10]=""Samochód Ciężarowy"",RC[-6]>16000),""Rigids""))"

Dim RigidsA As Range
For Each RigidsA In Range("L2:L921")
If RigidsA.Value = "Rigids" Then RigidsA.Offset(, -6).Value = "Rigids"
Next RigidsA

' Usunięcie kolumn pomocniczych "Artics" i "Rigids"

Range("K2:K921").Clear
Range("L2:L921").Clear


'Graficzne_uporządkowanie Makro

Range("A1").CurrentRegion.Select
Selection.Borders.LineStyle = xlContinuous

With Selection
Selection.HorizontalAlignment = xlCenter
Selection.VerticalAlignment = xlCenter
Selection.Font.Name = "Calibri"
Selection.Font.Size = 10

End With
Columns("H:H").ColumnWidth = 18.86
Columns("A:A").ColumnWidth = 14
Columns("C:C").ColumnWidth = 14

Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.799981688894314

End With

Range("A1").Select

' Print area

Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 300
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 0
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True

' Saving to PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\FileVBA.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False

' Getting file Path
Loc = ThisWorkbook.Path & "\FileVBA.pdf"
MsgBox Loc

'Screen updating should be activated
'Application.ScreenUpdating = True
End Sub

 

[Joe4]

Does this work?
MsgBox "The path is: " & ActiveWorkbook.Path

I would recommend putting this BEFORE the 'Saving to PDF block.

 

[cams88]

Ok. Yes it works, thank You very much

 

[Joe4]

You are welcome.

I would then recommend replacing "ThisWorkbook" with "ActiveWorkbook" in your "Saving to PDF" code block also.