PDA

View Full Version : [SOLVED] Import data from closed WB to textbox in userform



jmaocubo
01-25-2013, 09:45 AM
Hi...

I'm trying to create a userform that import data from one closed workbook to 2 userform textboxes. The workbook must be chosen from the explorer and start "c: \ plus the text from sheet 1 cell A2 \ GG "

I tried this (Not working):


Sub ExtractData()
Dim nwb As Workbook
Set nwb = Application.GetOpenFilename("Excel-files,*.xls*", _
1, "Select One File To Open", , False)
With nwb.Sheets("RDD")
.Range("A1").Value = UserForm1.Textbox1.Text
.Range("B1").Value = Userform1.Textbox2.Text
End With
nwb.Close True
End Sub

Thanks in advance

Miguel

CodeNinja
01-25-2013, 10:09 AM
Try opening the workbook...

The code you have (altered below) will update the workbooks from the data in the text boxes as I see it... you may want to change that bit around ... not sure if that is what you want or not...



Sub ExtractData()
Dim sWBPath As String
Dim nwb As Workbook
sWBPath = Application.GetOpenFilename("Excel-files,*.xls*", _
1, "Select One File To Open", , False)
Set nwb = Workbooks.Open(sWBPath)
With nwb.Sheets("RDD")
.Range("A1").Value = Userform1.Textbox1.Text
.Range("B1").Value = Userform1.Textbox2.Text
End With
nwb.Close True
End Sub

jmaocubo
01-25-2013, 11:05 AM
Try opening the workbook...

The code you have (altered below) will update the workbooks from the data in the text boxes as I see it... you may want to change that bit around ... not sure if that is what you want or not...



Sub ExtractData()
Dim sWBPath As String
Dim nwb As Workbook
sWBPath = Application.GetOpenFilename("Excel-files,*.xls*", _
1, "Select One File To Open", , False)
Set nwb = Workbooks.Open(sWBPath)
With nwb.Sheets("RDD")
.Range("A1").Value = Userform1.Textbox1.Text
.Range("B1").Value = Userform1.Textbox2.Text
End With
nwb.Close True
End Sub


Hi CodeNinja

Thanks for the replay :friends:

I just made a small change.


Sub ExtractData()
Dim sWBPath As String
Dim nwb As Workbook
sWBPath = Application.GetOpenFilename("Excel-files,*.xls*", _
1, "Select One File To Open", , False)
Set nwb = Workbooks.Open(sWBPath)
With nwb.Sheets("Folha1")
UserForm1.TextBox1.Text = .Range("A1").Value
UserForm1.TextBox2.Text = .Range("B1").Value
End With
nwb.Close True
End Sub

The problem is that the explorer must begin on a specific folder c:\ server\ the year (this must be by windows calendar)\GG\

Kenneth Hobs
01-25-2013, 12:28 PM
See if this helps.


Sub test()
MsgBox FileOpen("x:\", "Kens Files", "*.xls; *.xlsx; *.xlsm")
End Sub

Function FileOpen(initialFilename As String, _
Optional sDesc As String = "Excel (*.xls)", _
Optional sFilter As String = "*.xls") As String
With Application.FileDialog(msoFileDialogOpen)
.ButtonName = "&Open"
.initialFilename = initialFilename
.Filters.Clear
.Filters.Add sDesc, sFilter, 1
.Title = "File Open"
.AllowMultiSelect = False
If .show = -1 Then FileOpen = .SelectedItems(1)
End With
End Function

jmaocubo
01-25-2013, 01:04 PM
See if this helps.


Sub test()
MsgBox FileOpen("x:\", "Kens Files", "*.xls; *.xlsx; *.xlsm")
End Sub


Function FileOpen(initialFilename As String, _
Optional sDesc As String = "Excel (*.xls)", _
Optional sFilter As String = "*.xls") As String
With Application.FileDialog(msoFileDialogOpen)
.ButtonName = "&Open"
.initialFilename = initialFilename
.Filters.Clear
.Filters.Add sDesc, sFilter, 1
.Title = "File Open"
.AllowMultiSelect = False
If .show = -1 Then FileOpen = .SelectedItems(1)
End With
End Function

Many thanks Kenneth

I adjusted to my case and it works flawlessly :friends:

Kenneth Hobs
01-25-2013, 02:35 PM
I like closed workbook methods for getting some data more quickly. Here is an ADO method that is easy. http://www.rondebruin.nl/ado.htm

I like this method sometimes.


Sub t()
MsgBox GetValue("x:\test", "test.xlsx", "Sheet1", "A1")
End Sub

'=GetValue("c:\files", "budget.xls", "Sheet1", "A1")

Private Function GetValue(path, file, sheet, ref)
'path = "d:\files"
'file = "budget.xls"
'sheet = "Sheet1"
'ref = "A1:R30"
Dim arg As String
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValue = "file not found"
Exit Function
End If
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("a1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)
End Function

snb
01-25-2013, 02:49 PM
Private Sub Userform_initialize()
c00="C:\" & sheets("sheet1").range("A2").value & "\GG\"
c01= dir(c00 & "*.xlsx")
if c01<>"" then
with getobject(c00 & c01).sheets("RDD")
textbox1.Text=.cells(1,1).value
textbox2.Text=.cells(1,2).value
.Parent.close false
end with
end if
end Sub