VBA - get Open chdir

Private Sub import_file()

Dim myPath As String

Dim folderPath As String

folderPath = Application.ActiveWorkbook.Path

myPath = Application.ActiveWorkbook.FullName

Path = ActiveWorkbook.Path

With Application

.DisplayAlerts = False

'Turns of alerts

.AlertBeforeOverwriting = False

'Turns of overwrite alerts

.ScreenUpdating = False

'Turns of screen updating

End With

ws = ActiveWindow.Caption

Sheets("Home").Activate

SS = ActiveSheet.Name

Dim fname As Variant

ChDrive Path

'fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Choose File Material to import and split", MultiSelect:=False)

ChDrive Path

fname = Application.GetOpenFilename(Title:="Choose File Material to import and split", MultiSelect:=False)

If fname = False Then

MsgBox "User pressed cancel"

Exit Sub

Else

ChDir ruta

Workbooks.Open Filename:=fname

WI = ActiveWindow.Caption

SI = ActiveSheet.Name

End If

If Cells(1, 5).Value & Cells(1, 6).Value & Cells(1, 17).Value & Cells(1, 18).Value = "UPC / EANArticleCurr.Total" Then

Windows(ws).Activate

Sheets(SS).Select

For Each Sheet In ActiveWorkbook.Worksheets

If Sheet.Name = "TEMP" Then

Sheet.Delete

End If

Next Sheet

For x = 1 To 1000

If Cells(13, 1).Value <> "#" Then

Rows(13).EntireRow.Delete

Else

If Cells(13, 1).Value = "#" Then

x = 1000

End If

Next x

Cells(13, 1).Select

' Range("A:Q").Select

' Selection.ClearContents

' Range("A1").Select

' Range("R1").Value = "KWE SUB"

Windows(ws).Activate

Sheets.Add.Name = "TEMP"

ST = ActiveSheet.Name

Windows(WI).Activate

Range("E1", Range("R" & Rows.Count).End(xlUp)).Select

Selection.Copy

Windows(ws).Activate

Sheets(ST).Select

Cells(1, 1).Select

' Selection.Insert Shift:=xlDown

Rows("1:1").PasteSpecial xlPasteValues

Cells(1, 1).Select

Windows(WI).Activate

ActiveWindow.Close SaveChanges:=False

' copia e chiusura file

'---------------------------------------------------------------------------

Windows(ws).Activate

Cells(2, 1).Select

Lastrow = Cells(Rows.Count, "A").End(xlUp).Row

x = 2

For i = 1 To Lastrow - 1

Worksheets(SS).Activate

Rows(13).EntireRow.Select

Selection.Insert Shift:=xlDown

If ThisWorkbook.Sheets(ST).Range("A" & 1).Value = "UPC / EAN" Then

' ThisWorkbook.Sheets(SS).Range("A13:N13").Value = ThisWorkbook.Sheets(ST).Range("A" & x, "N" & x).Value

ThisWorkbook.Sheets(ST).Range("A" & x, "N" & x).Copy

ThisWorkbook.Sheets(SS).Range("A13:N13").PasteSpecial xlPasteFormulasAndNumberFormats

Dim FoundCell As Range

Const FIND As String = "#"

Set FoundCell = Range("A:A").FIND(What:=FIND)

If Not FoundCell Is Nothing Then

'MsgBox (WHAT_TO_FIND & " found in row: " & FoundCell.Row)

Else

'MsgBox (WHAT_TO_FIND & " not found")

End If

Range("N13").Select

Selection.Formula = "=L13*K13"

' Selection.Value = Format(ActiveCell.Value, 0)

Selection.NumberFormat = "0.00"

' Range("A13").NumberFormat = "0"

ThisWorkbook.Sheets(SS).Range("A" & FoundCell.Row, "N" & FoundCell.Row).Copy

ThisWorkbook.Sheets(SS).Range("A13:N13").PasteSpecial Paste:=xlPasteFormats

Rows(13).EntireRow.AutoFit

x = x + 1

End If

Next i

'---------------------------------------------------------------------------

For Each Sheet In ActiveWorkbook.Worksheets

If Sheet.Name = "TEMP" Then

Sheet.Delete

End If

Next Sheet

Sheets(SS).Select

Range("A1").Select

' MsgBox "import completed"

b = Format(DateTime.Now, "yyyy-MM-dd hhmmss")

Range("O1").Value = b

Else

MsgBox "File not correct - select the correct file "

End If

With Application

.DisplayAlerts = True

'Turns of alerts

.AlertBeforeOverwriting = True

'Turns of overwrite alerts

.ScreenUpdating = True

'Turns of screen updating

End With

End Sub