Solved: get the name of the selected file.

[hk43m]

Hi everybody,

this is the continuation of my first post (save specific cells).

I would like to load specific cells from a specific excel file which is chosen with a browse. (thank you Fumei)
My only problem is :

How give a name to the file the user has selected with the browse?
(the lines in red)

[vba] (excel 2003)

Option Explicit
Private Declare Function GetOpenFileName _
Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
(pOpenfilename As OpenFileName) As Long

Private Type OpenFileName
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Function BrowseForFile(sInitDir As String, _
Optional ByVal sFileFilters As String, _
Optional sTitle As String = "Open File", _
Optional lParentHwnd As Long) As String

Dim tFileBrowse As OpenFileName
Const clMaxLen As Long = 254

tFileBrowse.lStructSize = Len(tFileBrowse)

'Replace friendly deliminators with nulls
sFileFilters = Replace(sFileFilters, "|", vbNullChar)
sFileFilters = Replace(sFileFilters, ";", vbNullChar)
If Right$(sFileFilters, 1) <> vbNullChar Then
'Add final delimiter
sFileFilters = sFileFilters & vbNullChar
End If

'Select a filter
tFileBrowse.lpstrFilter = sFileFilters & _
"All Files (*.*)" & vbNullChar & "*.*" _
& vbNullChar
'create a buffer for the file
tFileBrowse.lpstrFile = String(clMaxLen, " ")
'set the maximum length of a returned file
tFileBrowse.nMaxFile = clMaxLen + 1
'Create a buffer for the file title
tFileBrowse.lpstrFileTitle = Space$(clMaxLen)
'Set the maximum length of a returned file title
tFileBrowse.nMaxFileTitle = clMaxLen + 1
'Set the initial directory
tFileBrowse.lpstrInitialDir = sInitDir
'Set the parent handle
tFileBrowse.hwndOwner = lParentHwnd
'Set the title
tFileBrowse.lpstrTitle = sTitle

'No flags
tFileBrowse.flags = 0

'Show the dialog
If GetOpenFileName(tFileBrowse) Then
BrowseForFile = Trim$(tFileBrowse.lpstrFile)
If Right$(BrowseForFile, 1) = vbNullChar Then
'Remove trailing null
BrowseForFile = Left$(BrowseForFile, _
Len(BrowseForFile) - 1)
End If
End If
End Function

Sub LoadTheCells()
Dim Name As String
Dim ws As Worksheet
Dim aWb As Workbook
Dim Sheet1 As Worksheet

Set ws = ActiveSheet
ActiveSheet.Unprotect ("code")

Name = MsgBox BrowseForFile("C:\Documents and Settings\43448586\My Documents\Macro\FolderTest", "Excel File (*.xls);*.xls", _
"Open Workbook")

Set aWb = Workbooks.Open("Name")
Set Sheet1 = aWb.ActiveSheet

With Sheet1
.Range("B3:B13").Copy
Cellela.[B3].PasteSpecial Paste:=xlValues
.Range("D3: D13").Copy
Cellela.[D3].PasteSpecial Paste:=xlValues
End With

aWb.Close SaveChanges:=False

ws.Protect ("code")

End Sub

Thanks a lot

[Bob Phillips]

[vba]

Sub LoadTheCells()
Dim Filename As String
Dim ws As Worksheet
Dim aWb As Workbook
Dim Sheet1 As Worksheet

Set ws = ActiveSheet
ActiveSheet.Unprotect "code"

With Application.FileDialog(msoFileDialogOpen)

.AllowMultiSelect = False
.InitialFileName = "C:\Documents and Settings\43448586\My Documents\Macro\FolderTest"
.FilterIndex = 2
.Title = "Open Workbook"

If .Show = 1 Then

Filename = .SelectedItems(1)


Set aWb = Workbooks.Open(Filename)
Set Sheet1 = aWb.ActiveSheet

With Sheet1
.Range("B3:B13").Copy
Cellela.[B3].PasteSpecial Paste:=xlValues
.Range("D3: D13").Copy
Cellela.[D3].PasteSpecial Paste:=xlValues
End With

aWb.Close SaveChanges:=False

ws.Protect "code"
End If
End With

End Sub
[/vba]

[hk43m]

Thanks,

But it only opens the FileDialog and does not copy & paste the values once I have selected the file. I don't know why because it should work...

Thanks again I m still looking for the error (no error message)

[Bob Phillips]

If you want me to check out why, you will need to post an example workbook.

[hk43m]

Yes sure, sorry.

Here is the file I want to import in
Attachment 9473

[hk43m]

and this is the file with the value I want to export

Attachment 9474

[hk43m]

I've just tried to run the macro without
If .Show = 1 Then
&
End If
it pastes always the same file and don't browse...

[hk43m]

well,

it works with : If .Show = -1 Then
instead of : If .Show = 1 Then

:-) hard to see...

Thank you very much for your help xld