
Power Query

January 30, 2020

Morning All,
I have database that upload data from a folder after when select a specific file from folder. When I select the folder, the Dialog folder box pops back up and you have to select the file again for the data to be uploaded. The following code below
Sub Get_Data_From_File1() '.....NSWTA SITE
MySheet3.Activate
Dim sFolder As String
Dim OpenBook As Workbook
' Open the select folder prompt
With Application.FileDialog(msoFileDialogOpen) ' THIS OPEN THE DIALOG BOX BUT OPENS TWICE???????????????????
If .Show = False Then Exit Sub ' IF USEWR CANCELS THE EXIT DIALOG BOX
Sheets("SiteFinder").Unprotect Password:="Online"
DeleteCurrentRegion2
.InitialFileName = "H:\PROJECT-OPS\NSW Warehouse\NSWTA Inventory Listing"
If .Show = -1 Then ' if OK is pressed
sFolder = .SelectedItems(1)
Application.ScreenUpdating = True
End If
End With
Application.ScreenUpdating = False
Set OpenBook = Application.Workbooks.Open(sFolder, Password:="Online")
OpenBook.Sheets(1).Range("A1:J" & Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row).Copy
ThisWorkbook.Worksheets("SiteFinder").Cells(Rows.Count, "C").End(xlUp).Offset(3, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
OpenBook.Close False
InsertTableArray1
Range("A1").Select
Protect_ShapesRange
End Sub
Its only after when the dialog box opens twice and select the file imports the data
Can someone tell me why the dialog box opens twice
Unfortunately I cannot supply you my database because it wont work outside the network!
Thanks
Steve

Power Query

January 30, 2020

Yes I see Catalin!
What I have done now is
Sub Get_Data_From_File1() '.....NSWTA SITE
MySheet3.Activate
Dim sFolder As String
Dim OpenBook As Workbook
' Open the select folder prompt
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = "H:\PROJECT-OPS\NSW Warehouse\NSWTA Inventory Listing"
If .Show = -1 Then ' if OK is pressed
sFolder = .SelectedItems(1)
Else ' IF USER CANCELS THEN EXIT THE SUB THEN MESSAGE
MsgBox ("ITS EITHER BECAUSE THE SITE HAS NOT BEEN RECEIPTED")
Exit Sub
Application.ScreenUpdating = True
End If
Sheets("SiteFinder").Unprotect Password:="Online"
DeleteCurrentRegion2
End With
Application.ScreenUpdating = False
Set OpenBook = Application.Workbooks.Open(sFolder, Password:="Online")
OpenBook.Sheets(1).Range("A1:J" & Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row).Copy
ThisWorkbook.Worksheets("SiteFinder").Cells(Rows.Count, "C").End(xlUp).Offset(3, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
OpenBook.Close False
InsertTableArray1
Range("A1").Select
Protect_ShapesRange
End Sub
All good thanks for that help
Steve
1 Guest(s)
