View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Sam Sam is offline
external usenet poster
 
Posts: 699
Default Help: Export specific data in a sheet in a new row

Thanks a lot for your help Patrick,

I made the changes you recommended, I am getting this error:

Set exApp = GetObject(, "Excel.Application")

On this line:

Set exApp = GetObject(, "Excel.Application")

Here is my code after your suggested changes:



Set exApp = GetObject(, "Excel.Application")

exApp.Visible = True

Set fdialog = exApp.FileDialog(msoFileDialogFilePicker)

With fdialog
.AllowMultiSelect = False
.Filters.Clear
.InitialFileName = filePath & "\*.xls*"

If .Show Then
pathAndFile = .SelectedItems(1)

shortName = Right(pathAndFile, _
Len(pathAndFile) - InStrRev(pathAndFile, "\"))
Else
MsgBox "User cancelled. Did not select a file"

End If
End With


Set newWkbk = exApp.Workbooks.Open(pathAndFile)

Set newWks = newWkbk.Sheets("Sheet1")


With newwks
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

With DestCell
.Value = Me.Student_Id.Value
.Offset(0, 1).Value = Me.FirstName.Value
.Offset(0, 2).Value = Me.LastName.Value
End With

'newWkbk.Close True
Set newWks = Nothing
Set newWkbk = Nothing
'exApp.Quit
Set exApp = Nothing

End Sub

Thanks in Advance.


"Patrick Molloy" wrote:

you have this line
.InitialFileName = filePath & "\*.xls*"

but filepath is defined already as:
filePath = "C:\My Documents\Students.xls"
so suggest you use
filePath = "C:\My Documents"

you could use the
Application.GetOpenFilename
instead of dialog boxes, which you;ll file easier anyway.

there's also some confusion in your naming convention ie
Dim newWks As Workbook
so newWks is a workbook, but later you try to use it as a worksheet
i suggest

Dim newWks As WorkSheet
Dim newWkBk As Workbook

so change this
Set newWks = exApp.Workbooks.Open(pathAndFile)

to
Set newWkBk = exApp.Workbooks.Open(pathAndFile)

and add

Set newWks = newWkBk.Activesheet

your

With newWks

now refers to a worksheet objecty correctly

finally, before the END SUB add

newWkBk.Close TRUE
set newWks = Nothing
set newWkBk=Nothing
exApp.Quit
set exApp = Nothing

which closes AND save the workbook, then frees the memory



Finally, get rid of the ON ERROR RESUME NEXT
this "hides" errors fro your code so that you can't see whats happening
use ON ERROR GOTO errLine

then add
errLine:
and handle the error correctly.








"sam" wrote:

Hi All,

I am trying this thing to work but its not working as I want.

Lets say I have a button "Export" on the userform, This userform has a
dropdown menu, which has student names, and selecting a student name from
that dropdown would populate other fields on the form such as, Name, Age,
Task etc..
So if i select Student1 from the dropdown, I will get the data of Student1
displayed on the form, If i select Student2 from the dropdown, I will get
data of Student2 displayed on the form.
Now when I click export, I want it to:
- open a file dialog box that lets me select another empty excel file
- once i select the excel file, i want the details of the select student to
be displayed in Row1
-If i select another student from the dropdown, i want the details of that
student to be displayed in Row2... and so on..
- Once I am done selecting the students, I want to manualy save the excel
file where I exported the student data.

Here is my code for the process:

Private Sub ExportToExcel_Click()

Dim exApp As Object
Dim exl As Object
Dim fdialog As FileDialog
Dim pathAndFile As String
Dim filePath As String
Dim shortName As String
Dim newWks As Workbook
Dim DestCell As Range
Dim FName As String

filePath = "C:\My Documents\Students.xls"

On Error Resume Next
Set exApp = GetObject(, "Excel.Application")

exApp.Visible = True

Set fdialog = exApp.FileDialog(msoFileDialogFilePicker)

With fdialog
.AllowMultiSelect = False
.Filters.Clear
.InitialFileName = filePath & "\*.xls*"

If .Show Then
pathAndFile = .SelectedItems(1)

shortName = Right(pathAndFile, _
Len(pathAndFile) - InStrRev(pathAndFile, "\"))
Else
MsgBox "User cancelled. Did not select a file"

End If
End With


Set newWks = exApp.Workbooks.Open(pathAndFile)


With newWks
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With

With DestCell
.Value = Me.Student_Id.Value
.Offset(0, 1).Value = Me.FirstName.Value
.Offset(0, 2).Value = Me.LastName.Value
End With


End Sub


Thanks in Advance