SOLVED

opening a file from file dialog box

Bronze Contributor

The SUB below copies a range from a worksheet of another workbook (selected from file dialog box) then paste it (values only) on the opened "RaD Analyzer.xlsm" file..

I am requesting for a vba for file dialog box to appear then choose a file (excel) instead of typing the filename for the "SourceFile".

many many thanks

 

 

Sub CopyFromSource()

** vba code for: open file dialog box then choose a file that will replace "SourceFile"

Windows("SourceFile").Activate
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Range("A2:J" & LastRow - 1).Select
Selection.Copy
Windows("RAD Analyzer.xlsm").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A2").Select

End Sub

 

 

 

16 Replies

Hi Lorenzo,

 

You need to create a new UserForm like this:

UserForm.png

 

And to use this code behind the UserForm:

 

UserFormCode.png

 

After that, you have to modify the code you mentioned as follow:

Sub CopyFromSource()

' vba code for: open file dialog box then choose a file that will replace "SourceFile"

 On Error Resume Next
 Application.ScreenUpdating = False
 
 Dim FileNameBoxInstance As New FileNameBox
 FileNameBoxInstance.Show
 Dim fileName As String
 fileName = FileNameBoxInstance.ComboBox1.Value

 Windows(fileName).Activate
 Dim LastRow As Long
 With ActiveSheet
 LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
 End With
 Range("A2:J" & LastRow - 1).Select
 Selection.Copy
 Windows("RAD Analyzer.xlsm").Activate
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 Range("A2").Select
 
 On Error GoTo 0
 Application.CutCopyMode = False
 Application.ScreenUpdating = True
 
End Sub

 

Please find all this in the attached file.

Regards

 

Mr. Amairah

Thank you for your reply.

Your suggestion is very nice but I need to select files instead of typing them. I found an article (pls see code below) . It opens the file dialog box and I can choose the file I need, the only problem is how do I continue after I chose a file - that is to replace SourceFile with the selected file?  I'm at a lost here.. your help would be most appreciated.

 

also How do you attach the file? Mr. Damien told me to find the Browse button below but there is only the Choose Files - is this the same? (I am attaching herewith an image of my message box).

 

Sub sbVBA_To_Open_Workbook_FileDialog()
Dim strFileToOpen As String

strFileToOpen = Application.GetOpenFilename _
(Title:="Please choose a file to open", _
FileFilter:="Excel Files *.xls* (*.xls*),")

If strFileToOpen = False Then
MsgBox "No file selected.", vbExclamation, "Sorry!"
Exit Sub
Else
Workbooks.Open Filename:=strFileToOpen
End If

End Sub


mbox.PNG

Sub sbVBA_To_Open_Workbook_FileDialog()
Dim strFileToOpen As String

strFileToOpen = Application.GetOpenFilename _
(Title:="Please choose a file to open", _
FileFilter:="Excel Files *.xls* (*.xls*),")

If strFileToOpen = False Then *** Error message is appearing here..
MsgBox "No file selected.", vbExclamation, "Sorry!"
Exit Sub
Else
Workbooks.Open Filename:=strFileToOpen
End If

End Sub
I would prefer this routine, It looks simpler
thank you Mr. Amairah

Mr. Amairah

I'm hope below is possible..

many many thanks

 

 

Sub CopyFromSource()

Dim strFileToOpen As String

strFileToOpen = Application.GetOpenFilename _
(Title:="Please choose a file to open", _
FileFilter:="") 'FileFilter:="Excel Files *.xls* (*.xls*),")

'** do not show opening of file by Application.EnableEvents = False?
'** opened file = mfilename

Windows(mfilename).Activate
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Range("A2:J" & LastRow).Select
Selection.Copy
Windows("RAD Analyzer.xlsm").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A2").Select

End Sub 

.. 

Mr. Amairah

EUREKA !!!

after so much trial - I think I get it..

would you kindly check if it is so.

thank you for your time...

 

 

Sub CopyFromSource()

Dim strFileToOpen As String
Dim mwrbk As Variant
strFileToOpen = Application.GetOpenFilename _
(Title:="Please choose a file to open", _
FileFilter:="")

Workbooks.Open Filename:=strFileToOpen

Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Range("A2:J" & LastRow).Select
Selection.Copy
Windows("Copy of RAD Analyzer.xlsm").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A2").Select

End Sub

 

best response confirmed by Lorenzo Kim (Bronze Contributor)
Solution

Hi Lorenzo,

 

The last one you mentioned is the best.

It seems that my suggestion is not perfect as it brings only the opened Excel files into the dropdown list.

 

However, I've updated the last code you mentioned this way so that it closes the source file after complete the process.

 

Also, I've deleted this variable because it's unused!

Dim mwrbk As Variant

 

This is the updated code:

Sub CopyFromSource2()

 On Error Resume Next
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 
 Dim strFileToOpen As String
 strFileToOpen = Application.GetOpenFilename _
 (Title:="Please choose a file to open", _
 FileFilter:="")
 
 Set targetedWB = Workbooks.Open(strFileToOpen)
 
 Dim LastRow As Long
 With ActiveSheet
 LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
 End With
 Range("A2:J" & LastRow).Select
 Selection.Copy
 Windows("RAD Analyzer.xlsm").Activate
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 
 targetedWB.Close SaveChanges:=False

 Range("A2").Select
 
 On Error GoTo 0
 Application.CutCopyMode = False
 Application.ScreenUpdating = True
 Application.DisplayAlerts = True

End Sub

 

Regards

Mr. Amairah

Thank you for your time and assistance.

more power to you..

Mr. Amairah

Pardon me for bothering you again.. the issue about attaching a file to this message box..

I noticed that you have attached a file - How did you do it?

I am attaching the image of my message box -- is this the regular format?

many thanks

 

image1.PNG

No problem.

 

As the screenshot you mentioned, the file MovieDatabase is already attached.

You can attach as many files as you want using the Choose Files Button.

 

Regards

Mr. Amairah

thank you for your time and assistance..

Mr. Amairah pardon my butting in the query below. I'd posted it at the forum for quite sometime now and haven't had any reply. I am just curious what the statement below means. if you would indulge me on this... many many thanks "you have earned so and so subscriptions"

Hi Lorenzo,

 

What is the statement you are asking for?

Mr. Amairah

Thank you for your reply.

I'm sorry - my message might have been garbled.

Sometime ago I recv'd message saying that I earned so and so "subscriptions"..

I wonder what this means...

many many thanks

Hi Lorenzo,

 

I think you mean the weekly digest email?

I receive such an email weekly (every Sunday).

 

This email notifies you about new topics or articles posted in boards you subscribe to

 

Weekly Digest.png

 

Mr. Amairah

Thank you for the info..

many many thanks

more power..

1 best response

Accepted Solutions
best response confirmed by Lorenzo Kim (Bronze Contributor)
Solution

Hi Lorenzo,

 

The last one you mentioned is the best.

It seems that my suggestion is not perfect as it brings only the opened Excel files into the dropdown list.

 

However, I've updated the last code you mentioned this way so that it closes the source file after complete the process.

 

Also, I've deleted this variable because it's unused!

Dim mwrbk As Variant

 

This is the updated code:

Sub CopyFromSource2()

 On Error Resume Next
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 
 Dim strFileToOpen As String
 strFileToOpen = Application.GetOpenFilename _
 (Title:="Please choose a file to open", _
 FileFilter:="")
 
 Set targetedWB = Workbooks.Open(strFileToOpen)
 
 Dim LastRow As Long
 With ActiveSheet
 LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
 End With
 Range("A2:J" & LastRow).Select
 Selection.Copy
 Windows("RAD Analyzer.xlsm").Activate
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 
 targetedWB.Close SaveChanges:=False

 Range("A2").Select
 
 On Error GoTo 0
 Application.CutCopyMode = False
 Application.ScreenUpdating = True
 Application.DisplayAlerts = True

End Sub

 

Regards

View solution in original post