Code error

C

Chey

I am using a code and I am getting the error compile error

Set xlw = xlx.Workbooks.Open("H:\shared\Travel-DPA\TA and TERF DHSS Linked
MASTER.xls"), , True
this is the path name to my file.
does it have to be on my hard drive????

here is the rest of my code

Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Set xlx = CreateObject("Excel.Application")
xlx.Visible = True
Set xlw = xlx.Workbooks.Open("H:\shared\Travel-DPA\TA and TERF DHSS Linked
MASTER.xls"), , True
Set xls = xlw.Worksheets("TA")
Set xlc = xls.Range("A1")
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("QueryName", dbOpenDynaset)
If rst.EOF = False And rst.BOF = False Then
rst.MoveFirst
' write header cells
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).name
Next lngColumn
Set xlc = xlc.Offset(1, 0)
Do While rst.EOF = False
' write data cells
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
Next lngColumn
rst.MoveNext
Set xlc = xlc.Offset(1, 0)
Loop
End If
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
Set xlc = Nothing
Set xls = Nothing
xlw.Close False
Set xlw = Nothing
xlx.Quit
Set xlx = Nothing

End Sub

Thanks
 
D

Dirk Goldgar

Chey said:
I am using a code and I am getting the error compile error

Set xlw = xlx.Workbooks.Open("H:\shared\Travel-DPA\TA and TERF DHSS Linked
MASTER.xls"), , True
this is the path name to my file.
does it have to be on my hard drive????

here is the rest of my code

Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Set xlx = CreateObject("Excel.Application")
xlx.Visible = True
Set xlw = xlx.Workbooks.Open("H:\shared\Travel-DPA\TA and TERF DHSS Linked
MASTER.xls"), , True
Set xls = xlw.Worksheets("TA")
Set xlc = xls.Range("A1")
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("QueryName", dbOpenDynaset)
If rst.EOF = False And rst.BOF = False Then
rst.MoveFirst
' write header cells
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).name
Next lngColumn
Set xlc = xlc.Offset(1, 0)
Do While rst.EOF = False
' write data cells
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
Next lngColumn
rst.MoveNext
Set xlc = xlc.Offset(1, 0)
Loop
End If
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
Set xlc = Nothing
Set xls = Nothing
xlw.Close False
Set xlw = Nothing
xlx.Quit
Set xlx = Nothing

End Sub
Click to expand...


If you're getting a compile error, it should be giving you a message telling
you the nature of the error, and it should also be highlighting the line on
which the error was found. Please post that information.
 
D

Dirk Goldgar

Chey said:
Compile Error:
Syntax Error.

it highlighted the whole role.
Click to expand...


The "whole role"? I'm not sure what that means. Do you mean it highlighted
*all* of the lines of code you posted, all at once? I don't believe I've
ever seen such a thing.

I don't see the Sub header for your procedure. I assumed there was one, but
you just failed to post it. Am I mistaken?
 
C

Chey

I ment row. Sorry. Yes there is a header. I will post everything
Private Sub Command60_Click()
Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Set xlx = CreateObject("Excel.Application")
xlx.Visible = True
Set xlw = xlx.Workbooks.open("H:\shared\Travel-DPA\TA and TERF DHSS Linked
MASTER.xls"), , True
Set xls = xlw.Worksheets("TA")
Set xlc = xls.Range("A1")
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("QRYPre_Approval_TA", dbOpenDynaset)
If rst.EOF = False And rst.BOF = False Then
rst.MoveFirst
' write header cells
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).name
Next lngColumn
Set xlc = xlc.Offset(1, 0)
Do While rst.EOF = False
' write data cells
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
Next lngColumn
rst.MoveNext
Set xlc = xlc.Offset(1, 0)
Loop
End If
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
Set xlc = Nothing
Set xls = Nothing
xlw.Close False
Set xlw = Nothing
xlx.Quit
Set xlx = Nothing

End Sub

this row
Set xlw = xlx.Workbooks.open("H:\shared\Travel-DPA\TA and TERF DHSS Linked
MASTER.xls"), , True

is red.

Thanks
 
D

Dirk Goldgar

Chey said:
I ment row. Sorry. Yes there is a header. I will post everything
Private Sub Command60_Click()
Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Set xlx = CreateObject("Excel.Application")
xlx.Visible = True
Set xlw = xlx.Workbooks.open("H:\shared\Travel-DPA\TA and TERF DHSS Linked
MASTER.xls"), , True
Set xls = xlw.Worksheets("TA")
Set xlc = xls.Range("A1")
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("QRYPre_Approval_TA", dbOpenDynaset)
If rst.EOF = False And rst.BOF = False Then
rst.MoveFirst
' write header cells
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).name
Next lngColumn
Set xlc = xlc.Offset(1, 0)
Do While rst.EOF = False
' write data cells
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
Next lngColumn
rst.MoveNext
Set xlc = xlc.Offset(1, 0)
Loop
End If
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
Set xlc = Nothing
Set xls = Nothing
xlw.Close False
Set xlw = Nothing
xlx.Quit
Set xlx = Nothing

End Sub

this row
Set xlw = xlx.Workbooks.open("H:\shared\Travel-DPA\TA and TERF DHSS Linked
MASTER.xls"), , True

is red.
Click to expand...


It looks to me like you have your closing parenthesis too early, and that
the line should probably read:

Set xlw = xlx.Workbooks.open("H:\shared\Travel-DPA\TA and TERF DHSS
Linked MASTER.xls", , True)

The above statement, though broken onto multiple lines by the newsreader,
should all be on one line in your actual code.
 
S

Steve Sanford

In my testing, the line should be

Set xlw = xlx.Workbooks.open("H:\shared\Travel-DPA\TA and TERF DHSS Linked
MASTER.xls")

The above line should all be on one line in your code.


Be aware that each row you write to in the worksheet will be offset each
time by
rst.Fields.Count columns because of this line:

Set xlc = xlc.Offset(1, 0)

It says move down one row but don't change the column position.

You would need to do something like this:

Dim ColKnt as varient

ColKnt = rst.Fields.Count

..
..
..

Set xlc = xlc.Offset(1, -ColKnt ) ' in both lines of code


HTH
 
C

Chey

So now I have the code
Private Sub Command60_Click()
Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Set xlx = CreateObject("Excel.Application")
xlx.Visible = True
Set xlw = xlx.Workbooks.Open("H:\shared\Travel-DPA\TA and TERF DHSS Linked
MASTER.xls ")
Set xls = xlw.Worksheets("TA")
Set xlc = xls.Range("A1")
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("QRYPre_Approval_TA", dbOpenDynaset)
If rst.EOF = False And rst.BOF = False Then
rst.MoveFirst
' write header cells
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).name
Next lngColumn
Set xlc = xlc.Offset(1, 0)
Do While rst.EOF = False
' write data cells
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
Next lngColumn
rst.MoveNext
Set xlc = xlc.Offset(1, 0)
Loop
End If
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
Set xlc = Nothing
Set xls = Nothing
xlw.Close False
Set xlw = Nothing
xlx.Quit
Set xlx = Nothing

End Sub

How do I only export the information present on my form. I think it is like
a where statement?

Also I have the following feilds that I would like in certain cells.
[Full Name] in cell A4
[TA Number] in cell R2
[Title] P4
[Mailing Address] A6
[City] O6
[State] V6
[Zip] W6
[Purpose of Trip] A11
[Orgin] D15
[Destination] R15

Can this be done by altering the code I have?

Thanks
 
S

Steve Sanford

Below are two Subs: "Private Sub Command60_Click()" and "Private Sub
Command2_Click()".

I modified your code "Private Sub Command60_Click()". It seems to work *for
me*.

I wasn't sure what you meant by: " How do I only export the information
present on my form". So the second Sub will transfer what is on a form to an
existing spreadsheet.

And I added some error handling.....

'----------beg code-------------------------------
Private Sub Command60_Click()
On Error GoTo Err_Command60_Click

Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim LastCol As Variant

Set xlx = CreateObject("Excel.Application")
Set xlw = xlx.Workbooks.Open("H:\shared\Travel-DPA\TA and TERF DHSS
Linked MASTER.xls ")
Set xls = xlw.Worksheets("TA")
Set xlc = xls.Range("A1")

xlx.Visible = True

Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("qryPW", dbOpenDynaset)

LastCol = rst.Fields.Count - 1

If rst.EOF = False And rst.BOF = False Then
rst.MoveLast
rst.MoveFirst
' write header cells
For lngColumn = 0 To LastCol
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
Next lngColumn

Set xlc = xlc.Offset(1, 0)
Do While rst.EOF = False
' write data cells
For lngColumn = 0 To LastCol
xlc.Offset(0, lngColumn) = rst.Fields(lngColumn)
Next lngColumn
rst.MoveNext
Set xlc = xlc.Offset(1, 0)
Loop
End If

Exit_Command60_Click:

On Error Resume Next
rst.Close
Set rst = Nothing
Set dbs = Nothing

xlw.Close ' asks if you want to save the workbook
' xlw.Close True ' saves wkbk - no question
' xlw.Close False ' will NOT save - no question


Set xlc = Nothing
Set xls = Nothing

Set xlw = Nothing
xlx.Quit
Set xlx = Nothing
Exit Sub

Err_Command60_Click:
MsgBox Err.Description
Resume Exit_Command60_Click

End Sub
'----------end code-------------------------------

How do I only export the information present on my form
Click to expand...
'----------beg code-------------------------------
Private Sub Command2_Click()
On Error GoTo Err_Command2_Click

Dim xlx As Object, xlw As Object, xls As Object, xlc As Object

Set xlx = CreateObject("Excel.Application")
Set xlw = xlx.Workbooks.Open("H:\shared\Travel-DPA\TA and TERF DHSS
Linked MASTER.xls ")
Set xls = xlw.Worksheets("TA")
Set xlc = xls.Range("A1")

xlx.Visible = True

'NOTE: "Me.txtFullName" refers to the name of the *control*
' on the form, not a field name

xls.Range("A4") = Me.txtFullName
xls.Range("A6") = Me.txtMailing
xls.Range("A11") = Me.txtPurpose
xls.Range("D15") = Me.txtOrgin
xls.Range("O6") = Me.txtCity
xls.Range("P4") = Me.txtTitle
xls.Range("R2") = Me.txtTANumber
xls.Range("R15") = Me.txtDestination
xls.Range("V6") = Me.txtState
xls.Range("W6") = Me.txtZip

Exit_Command2_Click:
On Error Resume Next

xlw.Close ' asks if you want to save the workbook
' xlw.Close True ' saves wkbk - no question
' xlw.Close False ' will NOT save - no question

Set xlc = Nothing
Set xls = Nothing

Set xlw = Nothing
xlx.Quit
Set xlx = Nothing
Exit Sub

Err_Command2_Click:
MsgBox Err.Description
Resume Exit_Command2_Click

End Sub
'----------end code-------------------------------

HTH
--
Steve S
--------------------------------
"Veni, Vidi, Velcro"
(I came; I saw; I stuck around.)


Chey said:
So now I have the code
Private Sub Command60_Click()
Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Set xlx = CreateObject("Excel.Application")
xlx.Visible = True
Set xlw = xlx.Workbooks.Open("H:\shared\Travel-DPA\TA and TERF DHSS Linked
MASTER.xls ")
Set xls = xlw.Worksheets("TA")
Set xlc = xls.Range("A1")
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("QRYPre_Approval_TA", dbOpenDynaset)
If rst.EOF = False And rst.BOF = False Then
rst.MoveFirst
' write header cells
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).name
Next lngColumn
Set xlc = xlc.Offset(1, 0)
Do While rst.EOF = False
' write data cells
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
Next lngColumn
rst.MoveNext
Set xlc = xlc.Offset(1, 0)
Loop
End If
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
Set xlc = Nothing
Set xls = Nothing
xlw.Close False
Set xlw = Nothing
xlx.Quit
Set xlx = Nothing

End Sub

How do I only export the information present on my form. I think it is like
a where statement?

Also I have the following feilds that I would like in certain cells.
[Full Name] in cell A4
[TA Number] in cell R2
[Title] P4
[Mailing Address] A6
[City] O6
[State] V6
[Zip] W6
[Purpose of Trip] A11
[Orgin] D15
[Destination] R15

Can this be done by altering the code I have?

Thanks
Click to expand...
 
C

Chey

I have tried working with the code and it opens the Excel Spreadsheet but
nothing gets brought over in the second code. The fisrt one transfer over
the whole query. How do I specify just the record I am in?
The second code looks like what I would want however it just open it.
I get an error message when I close the spreadsheet. It says
CCPO Switchboard cannot find the feild 'line' refered to in your expression.
When i click ok it does nothing so i am unsure where my error might be. i
will repost my code.

Private Sub Command60_Click()

On Error GoTo Err_Command60_Click

Dim xlx As Object, xlw As Object, xls As Object, xlc As Object

Set xlx = CreateObject("Excel.Application")
Set xlw = xlx.Workbooks.Open("H:\shared\Travel-DPA\TA and TERF DHSS
Linked MASTER.xls ")
Set xls = xlw.Worksheets("TA")
Set xlc = xls.Range("A1")

xlx.Visible = True

Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("QRYPre_Approval_TA", dbOpenDynaset)

LastCol = rst.Fields.Count - 1

'NOTE: "Me.txtFullName" refers to the name of the *control*
' on the form, not a field name

xls.Range("A4") = Me.[txtFull Name]
xls.Range("A6") = Me.[txtMailing_Address]
xls.Range("A11") = Me.[txtPurpose]
xls.Range("D15") = Me.[txtOrgin]
xls.Range("O6") = Me.[txtCity]
xls.Range("P4") = Me.[txtTitle]
xls.Range("R2") = Me.[txtTA Number]
xls.Range("R15") = Me.[txtDestination]
xls.Range("V6") = Me.[txtState]
xls.Range("W6") = Me.[txtZip]

Exit_Command60_Click:
On Error Resume Next

xlw.Close ' asks if you want to save the workbook
' xlw.Close True ' saves wkbk - no question
' xlw.Close False ' will NOT save - no question

Set xlc = Nothing
Set xls = Nothing

Set xlw = Nothing
xlx.Quit
Set xlx = Nothing
Exit Sub

Err_Command60_Click:
MsgBox Err.Description
Resume Exit_Command60_Click

End Sub

Thanks for your time.

Chey


Steve Sanford said:
Below are two Subs: "Private Sub Command60_Click()" and "Private Sub
Command2_Click()".

I modified your code "Private Sub Command60_Click()". It seems to work *for
me*.

I wasn't sure what you meant by: " How do I only export the information
present on my form". So the second Sub will transfer what is on a form to an
existing spreadsheet.

And I added some error handling.....

'----------beg code-------------------------------
Private Sub Command60_Click()
On Error GoTo Err_Command60_Click

Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim LastCol As Variant

Set xlx = CreateObject("Excel.Application")
Set xlw = xlx.Workbooks.Open("H:\shared\Travel-DPA\TA and TERF DHSS
Linked MASTER.xls ")
Set xls = xlw.Worksheets("TA")
Set xlc = xls.Range("A1")

xlx.Visible = True

Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("qryPW", dbOpenDynaset)

LastCol = rst.Fields.Count - 1

If rst.EOF = False And rst.BOF = False Then
rst.MoveLast
rst.MoveFirst
' write header cells
For lngColumn = 0 To LastCol
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
Next lngColumn

Set xlc = xlc.Offset(1, 0)
Do While rst.EOF = False
' write data cells
For lngColumn = 0 To LastCol
xlc.Offset(0, lngColumn) = rst.Fields(lngColumn)
Next lngColumn
rst.MoveNext
Set xlc = xlc.Offset(1, 0)
Loop
End If

Exit_Command60_Click:

On Error Resume Next
rst.Close
Set rst = Nothing
Set dbs = Nothing

xlw.Close ' asks if you want to save the workbook
' xlw.Close True ' saves wkbk - no question
' xlw.Close False ' will NOT save - no question


Set xlc = Nothing
Set xls = Nothing

Set xlw = Nothing
xlx.Quit
Set xlx = Nothing
Exit Sub

Err_Command60_Click:
MsgBox Err.Description
Resume Exit_Command60_Click

End Sub
'----------end code-------------------------------

How do I only export the information present on my form
Click to expand...
'----------beg code-------------------------------
Private Sub Command2_Click()
On Error GoTo Err_Command2_Click

Dim xlx As Object, xlw As Object, xls As Object, xlc As Object

Set xlx = CreateObject("Excel.Application")
Set xlw = xlx.Workbooks.Open("H:\shared\Travel-DPA\TA and TERF DHSS
Linked MASTER.xls ")
Set xls = xlw.Worksheets("TA")
Set xlc = xls.Range("A1")

xlx.Visible = True

'NOTE: "Me.txtFullName" refers to the name of the *control*
' on the form, not a field name

xls.Range("A4") = Me.txtFullName
xls.Range("A6") = Me.txtMailing
xls.Range("A11") = Me.txtPurpose
xls.Range("D15") = Me.txtOrgin
xls.Range("O6") = Me.txtCity
xls.Range("P4") = Me.txtTitle
xls.Range("R2") = Me.txtTANumber
xls.Range("R15") = Me.txtDestination
xls.Range("V6") = Me.txtState
xls.Range("W6") = Me.txtZip

Exit_Command2_Click:
On Error Resume Next

xlw.Close ' asks if you want to save the workbook
' xlw.Close True ' saves wkbk - no question
' xlw.Close False ' will NOT save - no question

Set xlc = Nothing
Set xls = Nothing

Set xlw = Nothing
xlx.Quit
Set xlx = Nothing
Exit Sub

Err_Command2_Click:
MsgBox Err.Description
Resume Exit_Command2_Click

End Sub
'----------end code-------------------------------

HTH
--
Steve S
--------------------------------
"Veni, Vidi, Velcro"
(I came; I saw; I stuck around.)


Chey said:
So now I have the code
Private Sub Command60_Click()
Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Set xlx = CreateObject("Excel.Application")
xlx.Visible = True
Set xlw = xlx.Workbooks.Open("H:\shared\Travel-DPA\TA and TERF DHSS Linked
MASTER.xls ")
Set xls = xlw.Worksheets("TA")
Set xlc = xls.Range("A1")
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("QRYPre_Approval_TA", dbOpenDynaset)
If rst.EOF = False And rst.BOF = False Then
rst.MoveFirst
' write header cells
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).name
Next lngColumn
Set xlc = xlc.Offset(1, 0)
Do While rst.EOF = False
' write data cells
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
Next lngColumn
rst.MoveNext
Set xlc = xlc.Offset(1, 0)
Loop
End If
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
Set xlc = Nothing
Set xls = Nothing
xlw.Close False
Set xlw = Nothing
xlx.Quit
Set xlx = Nothing

End Sub

How do I only export the information present on my form. I think it is like
a where statement?

Also I have the following feilds that I would like in certain cells.
[Full Name] in cell A4
[TA Number] in cell R2
[Title] P4
[Mailing Address] A6
[City] O6
[State] V6
[Zip] W6
[Purpose of Trip] A11
[Orgin] D15
[Destination] R15

Can this be done by altering the code I have?

Thanks
Click to expand...
Click to expand...
 
C

Chey

You said it is the control name not the name on the form. So does that mean
under Control Source? Just trying to figure things out.

Steve Sanford said:
Below are two Subs: "Private Sub Command60_Click()" and "Private Sub
Command2_Click()".

I modified your code "Private Sub Command60_Click()". It seems to work *for
me*.

I wasn't sure what you meant by: " How do I only export the information
present on my form". So the second Sub will transfer what is on a form to an
existing spreadsheet.

And I added some error handling.....

'----------beg code-------------------------------
Private Sub Command60_Click()
On Error GoTo Err_Command60_Click

Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim LastCol As Variant

Set xlx = CreateObject("Excel.Application")
Set xlw = xlx.Workbooks.Open("H:\shared\Travel-DPA\TA and TERF DHSS
Linked MASTER.xls ")
Set xls = xlw.Worksheets("TA")
Set xlc = xls.Range("A1")

xlx.Visible = True

Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("qryPW", dbOpenDynaset)

LastCol = rst.Fields.Count - 1

If rst.EOF = False And rst.BOF = False Then
rst.MoveLast
rst.MoveFirst
' write header cells
For lngColumn = 0 To LastCol
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
Next lngColumn

Set xlc = xlc.Offset(1, 0)
Do While rst.EOF = False
' write data cells
For lngColumn = 0 To LastCol
xlc.Offset(0, lngColumn) = rst.Fields(lngColumn)
Next lngColumn
rst.MoveNext
Set xlc = xlc.Offset(1, 0)
Loop
End If

Exit_Command60_Click:

On Error Resume Next
rst.Close
Set rst = Nothing
Set dbs = Nothing

xlw.Close ' asks if you want to save the workbook
' xlw.Close True ' saves wkbk - no question
' xlw.Close False ' will NOT save - no question


Set xlc = Nothing
Set xls = Nothing

Set xlw = Nothing
xlx.Quit
Set xlx = Nothing
Exit Sub

Err_Command60_Click:
MsgBox Err.Description
Resume Exit_Command60_Click

End Sub
'----------end code-------------------------------

How do I only export the information present on my form
Click to expand...
'----------beg code-------------------------------
Private Sub Command2_Click()
On Error GoTo Err_Command2_Click

Dim xlx As Object, xlw As Object, xls As Object, xlc As Object

Set xlx = CreateObject("Excel.Application")
Set xlw = xlx.Workbooks.Open("H:\shared\Travel-DPA\TA and TERF DHSS
Linked MASTER.xls ")
Set xls = xlw.Worksheets("TA")
Set xlc = xls.Range("A1")

xlx.Visible = True

'NOTE: "Me.txtFullName" refers to the name of the *control*
' on the form, not a field name

xls.Range("A4") = Me.txtFullName
xls.Range("A6") = Me.txtMailing
xls.Range("A11") = Me.txtPurpose
xls.Range("D15") = Me.txtOrgin
xls.Range("O6") = Me.txtCity
xls.Range("P4") = Me.txtTitle
xls.Range("R2") = Me.txtTANumber
xls.Range("R15") = Me.txtDestination
xls.Range("V6") = Me.txtState
xls.Range("W6") = Me.txtZip

Exit_Command2_Click:
On Error Resume Next

xlw.Close ' asks if you want to save the workbook
' xlw.Close True ' saves wkbk - no question
' xlw.Close False ' will NOT save - no question

Set xlc = Nothing
Set xls = Nothing

Set xlw = Nothing
xlx.Quit
Set xlx = Nothing
Exit Sub

Err_Command2_Click:
MsgBox Err.Description
Resume Exit_Command2_Click

End Sub
'----------end code-------------------------------

HTH
--
Steve S
--------------------------------
"Veni, Vidi, Velcro"
(I came; I saw; I stuck around.)


Chey said:
So now I have the code
Private Sub Command60_Click()
Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Set xlx = CreateObject("Excel.Application")
xlx.Visible = True
Set xlw = xlx.Workbooks.Open("H:\shared\Travel-DPA\TA and TERF DHSS Linked
MASTER.xls ")
Set xls = xlw.Worksheets("TA")
Set xlc = xls.Range("A1")
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("QRYPre_Approval_TA", dbOpenDynaset)
If rst.EOF = False And rst.BOF = False Then
rst.MoveFirst
' write header cells
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).name
Next lngColumn
Set xlc = xlc.Offset(1, 0)
Do While rst.EOF = False
' write data cells
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
Next lngColumn
rst.MoveNext
Set xlc = xlc.Offset(1, 0)
Loop
End If
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
Set xlc = Nothing
Set xls = Nothing
xlw.Close False
Set xlw = Nothing
xlx.Quit
Set xlx = Nothing

End Sub

How do I only export the information present on my form. I think it is like
a where statement?

Also I have the following feilds that I would like in certain cells.
[Full Name] in cell A4
[TA Number] in cell R2
[Title] P4
[Mailing Address] A6
[City] O6
[State] V6
[Zip] W6
[Purpose of Trip] A11
[Orgin] D15
[Destination] R15

Can this be done by altering the code I have?

Thanks
Click to expand...
Click to expand...
 
S

Steve Sanford

I am confused on what you want. You first post asked why didn't your code
work. On 3/24 you posted the code for "Private Sub Command60_Click()" and you
asked "How do I only export the information present on my form"?

I checked the code for "Private Sub Command60_Click()". In my testing, the
code transfers the recordset to an Excel spreadsheet.

For your question "How do I only export the information present on my
form"?, I modified the code to transfer the data in the controls you
indicated to the specific cells in the spreadsheet. I named this code
"Private Sub Command2_Click()". It only puts the data from the form to the
specific cells you indicated. It doesn't transfer the recordset.

BTW, to get the control name, in design mode, click on the control and open
the properties. Click in the "Other" tab. The top property is the control
name.

You now ask
the whole query. How do I specify just the record I am in?
Click to expand...

If you want to transfer just the fields that are bound to a control on your
form, you can:

- You can use a query with criteria to select the current primary key.

- Hard code it like the code in "Private Sub Command2_Click()".

- You can loop thru all the controls and transfer only the data in the
controls that have the TAG property set to some value. The code to select the
controls to traqnsfer would look something like this

'---------- Code Starts ----------
Dim ctl As Control
For Each ctl In Me.Controls
If ctl.Tag = "Required" Then
ctl.BackColor = vbRed
End If
Next
'---------- Code Ends ----------


Again, I'm not really sure what you are trying to do.


HTH
--
Steve S
--------------------------------
"Veni, Vidi, Velcro"
(I came; I saw; I stuck around.)


Chey said:
I have tried working with the code and it opens the Excel Spreadsheet but
nothing gets brought over in the second code. The fisrt one transfer over
the whole query. How do I specify just the record I am in?
The second code looks like what I would want however it just open it.
I get an error message when I close the spreadsheet. It says
CCPO Switchboard cannot find the feild 'line' refered to in your expression.
When i click ok it does nothing so i am unsure where my error might be. i
will repost my code.

Private Sub Command60_Click()

On Error GoTo Err_Command60_Click

Dim xlx As Object, xlw As Object, xls As Object, xlc As Object

Set xlx = CreateObject("Excel.Application")
Set xlw = xlx.Workbooks.Open("H:\shared\Travel-DPA\TA and TERF DHSS
Linked MASTER.xls ")
Set xls = xlw.Worksheets("TA")
Set xlc = xls.Range("A1")

xlx.Visible = True

Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("QRYPre_Approval_TA", dbOpenDynaset)

LastCol = rst.Fields.Count - 1

'NOTE: "Me.txtFullName" refers to the name of the *control*
' on the form, not a field name

xls.Range("A4") = Me.[txtFull Name]
xls.Range("A6") = Me.[txtMailing_Address]
xls.Range("A11") = Me.[txtPurpose]
xls.Range("D15") = Me.[txtOrgin]
xls.Range("O6") = Me.[txtCity]
xls.Range("P4") = Me.[txtTitle]
xls.Range("R2") = Me.[txtTA Number]
xls.Range("R15") = Me.[txtDestination]
xls.Range("V6") = Me.[txtState]
xls.Range("W6") = Me.[txtZip]

Exit_Command60_Click:
On Error Resume Next

xlw.Close ' asks if you want to save the workbook
' xlw.Close True ' saves wkbk - no question
' xlw.Close False ' will NOT save - no question

Set xlc = Nothing
Set xls = Nothing

Set xlw = Nothing
xlx.Quit
Set xlx = Nothing
Exit Sub

Err_Command60_Click:
MsgBox Err.Description
Resume Exit_Command60_Click

End Sub

Thanks for your time.

Chey


Steve Sanford said:
Below are two Subs: "Private Sub Command60_Click()" and "Private Sub
Command2_Click()".

I modified your code "Private Sub Command60_Click()". It seems to work *for
me*.

I wasn't sure what you meant by: " How do I only export the information
present on my form". So the second Sub will transfer what is on a form to an
existing spreadsheet.

And I added some error handling.....

'----------beg code-------------------------------
Private Sub Command60_Click()
On Error GoTo Err_Command60_Click

Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim LastCol As Variant

Set xlx = CreateObject("Excel.Application")
Set xlw = xlx.Workbooks.Open("H:\shared\Travel-DPA\TA and TERF DHSS
Linked MASTER.xls ")
Set xls = xlw.Worksheets("TA")
Set xlc = xls.Range("A1")

xlx.Visible = True

Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("qryPW", dbOpenDynaset)

LastCol = rst.Fields.Count - 1

If rst.EOF = False And rst.BOF = False Then
rst.MoveLast
rst.MoveFirst
' write header cells
For lngColumn = 0 To LastCol
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
Next lngColumn

Set xlc = xlc.Offset(1, 0)
Do While rst.EOF = False
' write data cells
For lngColumn = 0 To LastCol
xlc.Offset(0, lngColumn) = rst.Fields(lngColumn)
Next lngColumn
rst.MoveNext
Set xlc = xlc.Offset(1, 0)
Loop
End If

Exit_Command60_Click:

On Error Resume Next
rst.Close
Set rst = Nothing
Set dbs = Nothing

xlw.Close ' asks if you want to save the workbook
' xlw.Close True ' saves wkbk - no question
' xlw.Close False ' will NOT save - no question


Set xlc = Nothing
Set xls = Nothing

Set xlw = Nothing
xlx.Quit
Set xlx = Nothing
Exit Sub

Err_Command60_Click:
MsgBox Err.Description
Resume Exit_Command60_Click

End Sub
'----------end code-------------------------------

How do I only export the information present on my form
Click to expand...
'----------beg code-------------------------------
Private Sub Command2_Click()
On Error GoTo Err_Command2_Click

Dim xlx As Object, xlw As Object, xls As Object, xlc As Object

Set xlx = CreateObject("Excel.Application")
Set xlw = xlx.Workbooks.Open("H:\shared\Travel-DPA\TA and TERF DHSS
Linked MASTER.xls ")
Set xls = xlw.Worksheets("TA")
Set xlc = xls.Range("A1")

xlx.Visible = True

'NOTE: "Me.txtFullName" refers to the name of the *control*
' on the form, not a field name

xls.Range("A4") = Me.txtFullName
xls.Range("A6") = Me.txtMailing
xls.Range("A11") = Me.txtPurpose
xls.Range("D15") = Me.txtOrgin
xls.Range("O6") = Me.txtCity
xls.Range("P4") = Me.txtTitle
xls.Range("R2") = Me.txtTANumber
xls.Range("R15") = Me.txtDestination
xls.Range("V6") = Me.txtState
xls.Range("W6") = Me.txtZip

Exit_Command2_Click:
On Error Resume Next

xlw.Close ' asks if you want to save the workbook
' xlw.Close True ' saves wkbk - no question
' xlw.Close False ' will NOT save - no question

Set xlc = Nothing
Set xls = Nothing

Set xlw = Nothing
xlx.Quit
Set xlx = Nothing
Exit Sub

Err_Command2_Click:
MsgBox Err.Description
Resume Exit_Command2_Click

End Sub
'----------end code-------------------------------

HTH
--
Steve S
--------------------------------
"Veni, Vidi, Velcro"
(I came; I saw; I stuck around.)


Chey said:
So now I have the code
Private Sub Command60_Click()
Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Set xlx = CreateObject("Excel.Application")
xlx.Visible = True
Set xlw = xlx.Workbooks.Open("H:\shared\Travel-DPA\TA and TERF DHSS Linked
MASTER.xls ")
Set xls = xlw.Worksheets("TA")
Set xlc = xls.Range("A1")
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("QRYPre_Approval_TA", dbOpenDynaset)
If rst.EOF = False And rst.BOF = False Then
rst.MoveFirst
' write header cells
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).name
Next lngColumn
Set xlc = xlc.Offset(1, 0)
Do While rst.EOF = False
' write data cells
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
Next lngColumn
rst.MoveNext
Set xlc = xlc.Offset(1, 0)
Loop
End If
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
Set xlc = Nothing
Set xls = Nothing
xlw.Close False
Set xlw = Nothing
xlx.Quit
Set xlx = Nothing

End Sub

How do I only export the information present on my form. I think it is like
a where statement?

Also I have the following feilds that I would like in certain cells.
[Full Name] in cell A4
[TA Number] in cell R2
[Title] P4
[Mailing Address] A6
[City] O6
[State] V6
[Zip] W6
[Purpose of Trip] A11
[Orgin] D15
[Destination] R15

Can this be done by altering the code I have?

Thanks
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Export data to multiple Excel files using Template 0
run-time error '3121' no current record 2
Run-Time Error '3421': How do I fix it? 1
Exporting access table using vba to excel 1
insert a column in Excel then export data into Access table 0
Exclude "#DIV/0!" from Excel Import 3
Passing recordset parameters from code 1
Programmatically lock and put bakcolor as yellow only to the head 1

Top