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