how to export or save as in vba code

[pujangga2007]

Hello Guys

may help me

the code below running with outpus book1.xls, so I want to save automatically based from table with output name xls : Transaction _.Range("B1").Value = Nz(rs2!Product_Desc,_INVOICE_ "").Range("B2").Value = Nz(rs3!Product_Desc, "")_DAILY, and the how i can slip that need name above rs2,rs3 have save in path windows ? thanks in advance.


Option Compare Database

Private Sub view_invoice_Click()
Me.subformPBS_3.Requery
Me.subformPBS_5jadi.Requery
End Sub



Private Sub views_Click()
On Error GoTo SubError

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim SQL As String
Dim SQL1 As String
Dim SQL2 As String
Dim outputFileName As String
Dim path As String
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim rs3 As DAO.Recordset
Dim rs4 As DAO.Recordset
Dim i As Integer



'Show user work is being performed
DoCmd.Hourglass (True)



'*********************************************
' RETRIEVE DATA
'*********************************************
'SQL statement to retrieve data from database
SQL = "SELECT Product_Code, Product_Desc, Trade_Qty, hna, " & _
"GSV, NET " & _
"FROM PBS_5jadi_table WHERE hna > 2"

SQL1 = "SELECT Product_Desc FROM PBS_5jadi_table WHERE hna = 0 "
SQL2 = "SELECT Product_Desc FROM PBS_5jadi_table WHERE hna = 1 "
SQL3 = "SELECT Product_Desc FROM PBS_5jadi_table WHERE hna = 2 "

'Execute query and populate recordset
Set rs1 = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)
Set rs2 = CurrentDb.OpenRecordset(SQL1, dbOpenSnapshot)
Set rs3 = CurrentDb.OpenRecordset(SQL2, dbOpenSnapshot)
Set rs4 = CurrentDb.OpenRecordset(SQL3, dbOpenSnapshot)



'If no data, don't bother opening Excel, just quit
If rs1.RecordCount = 0 Then
MsgBox "No data selected for export", vbInformation + vbOKOnly, "No data exported"
GoTo SubExit
End If

'*********************************************
' BUILD SPREADSHEET
'*********************************************
'Create an instance of Excel and start building a spreadsheet

'coretan


'Early Binding
Set xlApp = Excel.Application


xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)

outputFileName = Range("B1").Value = Nz(rs2!Product_Desc, "")

'With xlBook
'DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "rs3", "D:\AAA_STOK\BERNO\coba.xls", True, ""
'End With

With xlSheet
.Name = "ZBBS_print"
.Cells.Font.Name = "Calibri"
.Cells.Font.Size = 11

'Set column widths
.Columns("A").ColumnWidth = 15
.Columns("B").ColumnWidth = 15
.Columns("C").ColumnWidth = 15
.Columns("D").ColumnWidth = 10
.Columns("E").ColumnWidth = 10
.Columns("F").ColumnWidth = 10

'Format columns
.Columns("C").NumberFormat = "#,##0;-#,##0"
.Columns("D").NumberFormat = "#,##0;-#,##0"
.Columns("E").NumberFormat = "#,##0;-#,##0"
.Columns("F").NumberFormat = "#,##0;-#,##0"
.Columns("G").NumberFormat = "#,##0;-#,##0"
.Columns("H").NumberFormat = "#,##0;-#,##0"

'build report heading
'.Range("A1", "F1").Merge
'.Range("A2", "F2").Merge
.Range("A1").HorizontalAlignment = xlLeft
.Range("A2").HorizontalAlignment = xlLeft
'.Range("A1").Cells.Font.Bold = True
'.Range("A2").Cells.Font.Bold = True
.Range("A1").Cells.Font.Name = "Cambria"
.Range("A2").Cells.Font.Name = "Cambria"
.Range("A3").Cells.Font.Name = "Cambria"
.Range("A1").Cells.Font.Size = 14
.Range("A2").Cells.Font.Size = 14
.Range("A3").Cells.Font.Size = 14
.Range("B1").Cells.Font.Size = 14
.Range("B2").Cells.Font.Size = 14
'.Range("A1").Value = "Discount Listing"
'.Range("A2").Value = Date

.Range("A1").Value = "TANGGAL :"
.Range("A2").Value = "No_Faktur_MDI"
'.Range("A3").Value = " "

'build column headings
.Range("A4").Value = "No"
.Range("B4").Value = "No. Kode"
.Range("C4").Value = "Nama Produk"
.Range("D4").Value = "faktur_today"
.Range("E4").Value = "HNA"
.Range("F4").Value = "Value"
.Range("G4").Value = "NET"
.Range("H4").Value = "Diskon"

'Format Column Headings
.Range("A4:H4").HorizontalAlignment = xlLeft
.Range("A4:H4").Cells.Font.Bold = True

'If rs2.RecordCount = 0 Then
'MsgBox "No data selected for export", vbInformation + vbOKOnly, "No data exported"
'GoTo SubExit
'End If


.Range("B1").Value = Nz(rs2!Product_Desc, "")
.Range("B2").Value = Nz(rs3!Product_Desc, "")
.Range("A3").Value = Nz(rs4!Product_Desc, 0)

'provide initial value to row counter
i = 5
'Loop through recordset and copy data from recordset to sheet
Do While Not rs1.EOF

.Range("B" & i).Value = Nz(rs1!Product_Code, "")
.Range("C" & i).Value = Nz(rs1!Product_Desc, 0)
.Range("D" & i).Value = Nz(rs1!Trade_Qty, 0)
.Range("E" & i).Value = Nz(rs1!hna, 0)
.Range("F" & i).Value = Nz(rs1!GSV, 0)
.Range("G" & i).Value = Nz(rs1!NET, 0)

'Example: (Price - SalesPrice) / Price
'Example: =(C5 - D5) / C5
'.Range("F" & i).Formula = "=(C" & i & " - D" & i & ") / C" & i

i = i + 1
rs1.MoveNext



Loop

'Formulas for total line
'Count items
.Range("A" & i).Value = "Total Items:"
.Range("A" & i).HorizontalAlignment = xlRight
'Example: =COUNTA(B5:B12)
.Range("B" & i).Formula = "=COUNTA(B5:B" & i - 1 & ")"
.Range("B" & i).HorizontalAlignment = xlLeft

'Average discount
.Range("C" & i, "E" & i).Merge
.Range("C" & i).HorizontalAlignment = xlRight
.Range("C" & i).Value = "Average Value:"
'=AVERAGE(F5:F12)
.Range("F" & i).Formula = "=AVERAGE(F5:F" & i - 1

.Range("A" & i & ":H" & i).Cells.Font.Bold = True

'grid-lines: left of empty column
.Range("A4:H4").Borders(xlEdgeTop).LineStyle = XlLineStyle.xlContinuous
.Range("A4:A" & i).Borders(xlEdgeLeft).LineStyle = XlLineStyle.xlContinuous
.Range("A4:H" & i - 1).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
.Range("A4:H" & i - 1).Borders(xlInsideVertical).LineStyle = XlLineStyle.xlContinuous
.Range("A4:H" & i - 1).Borders(xlInsideHorizontal).LineStyle = XlLineStyle.xlContinuous
.Range("A4:H" & i - 1).Borders(xlEdgeBottom).Weight = XlBorderWeight.xlMedium

'grid-lines: right of empty column
'.Range("H4:H" & i - 1).Borders(xlEdgeLeft).LineStyle = XlLineStyle.xlContinuous
.Range("H4:H" & i).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
.Range("H4:H" & i - 1).Borders(xlInsideHorizontal).LineStyle = XlLineStyle.xlContinuous

'Grid-line: under total line
.Range("A" & i & ":H" & i).Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous

i = i + 2
'Create footnote just for fun
.Range("A" & i, "F" & i).Merge
.Range("A" & i).Value = "* Caveat Emptor! Discounts can change at any time!"
.Range("A" & i).Cells.Font.Size = 10
.Range("A" & i).Characters(30, 10).Font.Bold = True
.Range("A" & i).Characters(30, 10).Font.Italic = True
.Range("A" & i).Characters(30, 10).Font.Color = vbRed

End With


'outputFileName = CurrentProject.Path & Format(rs2) & "_" & Format(rs3) & ".xls"
'DoCmd.OutputTo acOutputReport, acSpreadsheetTypeExcel9, "PBS_5jadi_table", acFormatXLS, "D:\AAA_STOK\DNRUDCKLSPZ\rptletterdate.xls"
'path = "D:\AAA_STOK\DNRUDCKLSPZ\"
'ActiveWorkbook.SaveAs outputFileName:=path & outputFileName & ".xls", outputFileName:=xlNormal




SubExit:
On Error Resume Next

DoCmd.Hourglass False
xlApp.Visible = True
rs1.Close
Set rs1 = Nothing

Exit Sub

SubError:
MsgBox "Error Number: " & Err.Number & "= " & Err.Description, vbCritical + vbOKOnly, _
"An error occurred"
GoTo SubExit

End Sub