Using SaveAs on an Excel Sheet from Access usinf vbText constant v

[Melvis]

Hi!

You all are usually a great help. I got a good one for you. I am using
Access to create a spreadsheet, and I want to save it as a tab-delimited text
file. When I run it, it works fine except I have to accept several dialog
boxes about saving Excel as tab delimited instead of normal and I may lose
formatting. Is there any way to just force Excel to save all changes without
prompting the user? I don't want the users to have to click "yes" and "ok" 5
times just to get this done...

Here is my code:

Private Sub Command9_Click()
On Error GoTo ErrorHandler
Dim DB As DAO.Database, Rs As DAO.Recordset
Dim i As Integer, j As Integer
Dim RsSql As String
Dim FileName As String
Dim CurrentValue As Variant
Dim CurrentField As Variant
Dim Workbook As Object
Dim xlApp As Object
Dim Sheet As Object
Dim oBook As Object

Set DB = DBEngine.Workspaces(0).Databases(0)

RsSql = "SELECT * FROM qryAllValueAdjustments WHERE ([InReview] = " &
True & ");"

Set Rs = DB.OpenRecordset(RsSql, dbOpenDynaset)
Set xlApp = CreateObject("Excel.Application")
Set oBook = xlApp.workbooks.Add
Set Sheet = xlApp.activeworkbook.sheets(1)

' Create header cells
Sheet.Range("A1:J1").Value = Array("[Variant ID]", "[Variant Text]",
"&DOCNUMBER", "&LINEITEM", _
"&DOCTYPE", "&DOCDATE", "&DESCRIPTION", "&INCREASE", "&DECREASE",
"&AMOUNT")
Sheet.Range("A2:J2").Value = Array("-->", "Parameter texts", "Document
number", "Document item", _
"Document type", "Document date", "Description", "Value increase",
"Value decrease", "Amount")
Sheet.Range("A3:H3").Value = Array("-->", "Default Values", "", "", _
"", "", "", "X")
Sheet.Range("A4").Value = "*** Changes to the default values displayed
above not effective"

j = 6

' Loop through the Microsoft Access records and copy the records
' to the Microsoft Excel spreadsheet.
Do Until Rs.EOF
For i = 0 To Rs.Fields.Count - 3
CurrentField = Rs(i)

If (i = (Rs.Fields.Count - 3)) Then
Rs.Edit
Rs!Exported = vbYes
Rs!InReview = False
Rs.Update
Else
Sheet.cells(j, i + 3).Value = CurrentField
End If


Next i
Rs.MoveNext
j = j + 1
Loop

'Save the Workbook and Quit Excel

FileName = "C:\Spreadsheet for " & Date$ & " at " & _
Left(Time$(), 2) & Mid(Time$(), 4, 2) & " hours.txt"

oBook.SaveAs FileName, -4158 ' constant vbText = -4158

MsgBox ("File successfully saved as " & FileName)

Set Sheet = Nothing
Set oBook = Nothing
xlApp.Quit
Set xlApp = Nothing


Exit_ErrorHandler:
Exit Sub

ErrorHandler:
MsgBox Err.Description
Resume Exit_ErrorHandler

End Sub

 

[John Nurick]

Hi Melvis,

I think you'll find it's the xlApp.Quit that's generating these
messages, not the .SaveAs. Just close the workbook before quitting
oBook.Close False

Hi!

You all are usually a great help. I got a good one for you. I am using
Access to create a spreadsheet, and I want to save it as a tab-delimited text
file. When I run it, it works fine except I have to accept several dialog
boxes about saving Excel as tab delimited instead of normal and I may lose
formatting. Is there any way to just force Excel to save all changes without
prompting the user? I don't want the users to have to click "yes" and "ok" 5
times just to get this done...

Here is my code:

Private Sub Command9_Click()
On Error GoTo ErrorHandler
Dim DB As DAO.Database, Rs As DAO.Recordset
Dim i As Integer, j As Integer
Dim RsSql As String
Dim FileName As String
Dim CurrentValue As Variant
Dim CurrentField As Variant
Dim Workbook As Object
Dim xlApp As Object
Dim Sheet As Object
Dim oBook As Object

Set DB = DBEngine.Workspaces(0).Databases(0)

RsSql = "SELECT * FROM qryAllValueAdjustments WHERE ([InReview] = " &
True & ");"

Set Rs = DB.OpenRecordset(RsSql, dbOpenDynaset)
Set xlApp = CreateObject("Excel.Application")
Set oBook = xlApp.workbooks.Add
Set Sheet = xlApp.activeworkbook.sheets(1)

' Create header cells
Sheet.Range("A1:J1").Value = Array("[Variant ID]", "[Variant Text]",
"&DOCNUMBER", "&LINEITEM", _
"&DOCTYPE", "&DOCDATE", "&DESCRIPTION", "&INCREASE", "&DECREASE",
"&AMOUNT")
Sheet.Range("A2:J2").Value = Array("-->", "Parameter texts", "Document
number", "Document item", _
"Document type", "Document date", "Description", "Value increase",
"Value decrease", "Amount")
Sheet.Range("A3:H3").Value = Array("-->", "Default Values", "", "", _
"", "", "", "X")
Sheet.Range("A4").Value = "*** Changes to the default values displayed
above not effective"

j = 6

' Loop through the Microsoft Access records and copy the records
' to the Microsoft Excel spreadsheet.
Do Until Rs.EOF
For i = 0 To Rs.Fields.Count - 3
CurrentField = Rs(i)

If (i = (Rs.Fields.Count - 3)) Then
Rs.Edit
Rs!Exported = vbYes
Rs!InReview = False
Rs.Update
Else
Sheet.cells(j, i + 3).Value = CurrentField
End If


Next i
Rs.MoveNext
j = j + 1
Loop

'Save the Workbook and Quit Excel

FileName = "C:\Spreadsheet for " & Date$ & " at " & _
Left(Time$(), 2) & Mid(Time$(), 4, 2) & " hours.txt"

oBook.SaveAs FileName, -4158 ' constant vbText = -4158

MsgBox ("File successfully saved as " & FileName)

Set Sheet = Nothing
Set oBook = Nothing
xlApp.Quit
Set xlApp = Nothing


Exit_ErrorHandler:
Exit Sub

ErrorHandler:
MsgBox Err.Description
Resume Exit_ErrorHandler

End Sub

 

[Jamie Collins]

I think you'll find it's the xlApp.Quit that's generating these
messages, not the .SaveAs. Just close the workbook before quitting
oBook.Close False

Of course, the OP could simple execute

SELECT <<column list with appropriate aliases>>
INTO
[Text;HDR=Yes;Database=C:\].[Spreadsheet for <<date time here>>
hours#txt]
FROM qryAllValueAdjustments
WHERE InReview = TRUE
;

Then

UPDATE qryAllValueAdjustments SET
Exported = 6,
InReview = FALSE
;

The only difference is the OP may want tab delimited and the above
will default to csv. However, creating/amending a scheme.ini/spec is
easy enough and saves the unnecessary overhead of automating Excel and
looping through a recordset.

Jamie.

--