So, this code that follows works fine. It runs a query and exports the data into Excel 2016.
My problem is it does not format the data in Excel. It appears its not saving. I need help in formatting my output. I think i am missing a piece of code. Please help me.
Silvana
Private Sub Command71_Click()
DoCmd.SetWarnings False
Dim myFileName As String
Dim myDate
Dim myDateMM
Dim myDateDD
Dim myDateYY
myDate = Date
myDateMM = Month(Date)
myDateDD = Day(Date)
myDateYY = Year(Date)
myDate2 = myDateMM & "." & myDateDD & "." & Mid(myDateYY, 3, 2)
ptext1 = "Please Enter the VendorName"
myFileName = InputBox(ptext1, "Need Input")
MyfileDir1 = "S:\Silvana\SRs\SR_TEST_" & myFileName & "_" & myDate2 & ".xlsx"
myFileDir2 = "S:\Silvana\SRs\SR_TEST(Pre)_" & myFileName & "_" & myDate2 & ".xlsx"
'-------------------------------- Delete Output Files---------------------------------------------'
Dim aFile As String
aFile = "S:\Silvana\SRs\SR_TEST_" & myFileName & "_" & myDate2 & ".xlsx"
If Len(Dir$(aFile)) > 0 Then
SetAttr aFile, vbNormal
Kill aFile
End If
bFile = "S:\Silvana\SRs\SR_TEST(Pre)_" & myFileName & "_" & myDate2 & ".xlsx"
If Len(Dir$(bFile)) > 0 Then
SetAttr bFile, vbNormal
Kill bFile
End If
'--------------------------------------------------------------------------------------------------'
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "SR_UpdPrice_ExactActive", "S:\Silvana\SRs\SR_TEST_" & myFileName & "_" & myDate2 & ".xlsx", True, "ExactActive"
Dim appExcel As Object
Dim workBook As Object
Dim workSheet As Object
strTemplatesPath = "S:\Silvana\SRs"
'Set workBook = workBook("S:\Silvana\SRs\SR_TEST_" & myFileName & "_" & myDate2 & ".xlsx")
'-----------------------------------------------------------------------------------------------------------------------------------------------------'
'-----------------------------------------------------------------------------------------------------------------------------------------------------'
strSheet = MyfileDir1
MsgBox "Excel workbook: " & strSheet
' Open an existing spreadsheet
Set appExcel = GetObject(strSheet)
' Show spreadsheet on screen
'appExcel.Application.Visible = True
'appExcel.Parent.Windows(1).Visible = False
' Autofit all columns on a worksheet and apply heading format and autofilter
'Prevent Computer Screen from running
appExcel.Application.ScreenUpdating = False
'Allow Computer Screen to refresh (not necessary in most cases)
appExcel.Application.ScreenUpdating = True
appExcel.Application.DisplayAlerts = True
Set workSheet = appExcel.Worksheets("ExactActive")
workSheet.Range("A1:AX65000").Font.Size = 7.5
workSheet.Range("A1:B1").Interior.ColorIndex = 22
workSheet.Range("A2:B65000").Interior.ColorIndex = 22
workSheet.Range("C1:M1").Interior.ColorIndex = 4
workSheet.Range("C2:M65000").Interior.ColorIndex = 19
workSheet.Range("N1:T1").Interior.ColorIndex = 37
workSheet.Range("N2:T65000").Interior.ColorIndex = 20
workSheet.Range("U1:AB1").Interior.ColorIndex = 39
workSheet.Range("U2:AB65000").Interior.ColorIndex = 24
workSheet.Range("AC1:AD1").Interior.ColorIndex = 43
workSheet.Range("AC2:AD65000").Interior.ColorIndex = 35
workSheet.Range("AE1:AF1").Interior.ColorIndex = 4
workSheet.Range("AE2:AF65000").Interior.ColorIndex = 19
workSheet.Range("AG1:AJ1").Interior.ColorIndex = 43
workSheet.Range("AG2:AJ65000").Interior.ColorIndex = 35
workSheet.Range("AK1:AL1").Interior.ColorIndex = 39
workSheet.Range("AK2:AL65000").Interior.ColorIndex = 24
workSheet.Range("AM1:AM1").Interior.ColorIndex = 4
workSheet.Range("AM2:AM65000").Interior.ColorIndex = 19
workSheet.Cells.EntireColumn.AutoFit
With workSheet
workSheet.Range("A1:AM65000").Font.Size = 7#
workSheet.Range("C1:C65000").ColumnWidth = 18 'PSNo'
workSheet.Range("D165000").ColumnWidth = 20 'VndrItmID'
workSheet.Range("E1:E65000").ColumnWidth = 3 'UOM'
workSheet.Range("F1:F65000").ColumnWidth = 12 'NewPrice'
workSheet.Range("G1:G65000").ColumnWidth = 10 'VendorNo'
workSheet.Range("H1:H65000").ColumnWidth = 15 'VendorName'
workSheet.Range("I1:I65000").ColumnWidth = 5 'Location'
workSheet.Range("J1:J65000").ColumnWidth = 5 'Dflt UOM'
workSheet.Range("K1:K65000").ColumnWidth = 10 'Diff'
workSheet.Range("L1:L65000").ColumnWidth = 7 'UOMFlg'
workSheet.Range("M1:M65000").ColumnWidth = 7 'CnvFlg'
workSheet.Range("N1:N65000").ColumnWidth = 5 'IM-->'
workSheet.Range("O1:R65000").ColumnWidth = 7 'IMaster data'
workSheet.Range("S1:T65000").ColumnWidth = 10 'IMaster data'
workSheet.Range("U1:AB65000").ColumnWidth = 10 'IMaster data'
workSheet.Range("AC1:AH65000").ColumnWidth = 10 'IMaster data'
workSheet.Range("AE1:AF65000").ColumnWidth = 9 'IMaster data'
workSheet.Range("AI1:AJ65000").ColumnWidth = 30 'IMaster data'
With xlsheet1
workSheet.Range("C1:G65000").Font.Bold = True
workSheet.Range("C2:G65000").Font.ColorIndex = 51 'deep green'
workSheet.Range("K1:M65000").Font.Bold = True
workSheet.Range("K1:M65000").Font.ColorIndex = 3
workSheet.Range("K1:M65000").Font.Size = 8#
workSheet.Range("N1:N65000").Font.Bold = True
workSheet.Range("P1:T65000").Font.Size = 8#
workSheet.Range("P1:T65000").Font.Bold = True
workSheet.Range("P2:T65000").Font.ColorIndex = 53
workSheet.Range("U1:AB65000").Font.Size = 8.5
workSheet.Range("U1:AB65000").Font.Bold = True
workSheet.Range("U2:AB65000").Font.ColorIndex = 53
workSheet.Range("AE1:AF65000").Font.Size = 8#
workSheet.Range("AE1:AF65000").Font.Bold = True
workSheet.Range("AE2:AF65000").Font.ColorIndex = 53
workSheet.Range("AM1:AM65000").Font.Size = 8#
workSheet.Range("AM1:AM65000").Font.Bold = True
workSheet.Range("AM2:AM65000").Font.ColorIndex = 53
End With
End With
With workSheet
.Range("A1:AP1").AutoFilter
End With
'------------------ Remove Blank Rows --------------------------------------------------'
With workSheet
.Range("A1:AP65000").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42), Header:=xlYes
End With
Set dbs = Nothing
MsgBox "Done"
End Sub
My problem is it does not format the data in Excel. It appears its not saving. I need help in formatting my output. I think i am missing a piece of code. Please help me.
Silvana
Private Sub Command71_Click()
DoCmd.SetWarnings False
Dim myFileName As String
Dim myDate
Dim myDateMM
Dim myDateDD
Dim myDateYY
myDate = Date
myDateMM = Month(Date)
myDateDD = Day(Date)
myDateYY = Year(Date)
myDate2 = myDateMM & "." & myDateDD & "." & Mid(myDateYY, 3, 2)
ptext1 = "Please Enter the VendorName"
myFileName = InputBox(ptext1, "Need Input")
MyfileDir1 = "S:\Silvana\SRs\SR_TEST_" & myFileName & "_" & myDate2 & ".xlsx"
myFileDir2 = "S:\Silvana\SRs\SR_TEST(Pre)_" & myFileName & "_" & myDate2 & ".xlsx"
'-------------------------------- Delete Output Files---------------------------------------------'
Dim aFile As String
aFile = "S:\Silvana\SRs\SR_TEST_" & myFileName & "_" & myDate2 & ".xlsx"
If Len(Dir$(aFile)) > 0 Then
SetAttr aFile, vbNormal
Kill aFile
End If
bFile = "S:\Silvana\SRs\SR_TEST(Pre)_" & myFileName & "_" & myDate2 & ".xlsx"
If Len(Dir$(bFile)) > 0 Then
SetAttr bFile, vbNormal
Kill bFile
End If
'--------------------------------------------------------------------------------------------------'
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "SR_UpdPrice_ExactActive", "S:\Silvana\SRs\SR_TEST_" & myFileName & "_" & myDate2 & ".xlsx", True, "ExactActive"
Dim appExcel As Object
Dim workBook As Object
Dim workSheet As Object
strTemplatesPath = "S:\Silvana\SRs"
'Set workBook = workBook("S:\Silvana\SRs\SR_TEST_" & myFileName & "_" & myDate2 & ".xlsx")
'-----------------------------------------------------------------------------------------------------------------------------------------------------'
'-----------------------------------------------------------------------------------------------------------------------------------------------------'
strSheet = MyfileDir1
MsgBox "Excel workbook: " & strSheet
' Open an existing spreadsheet
Set appExcel = GetObject(strSheet)
' Show spreadsheet on screen
'appExcel.Application.Visible = True
'appExcel.Parent.Windows(1).Visible = False
' Autofit all columns on a worksheet and apply heading format and autofilter
'Prevent Computer Screen from running
appExcel.Application.ScreenUpdating = False
'Allow Computer Screen to refresh (not necessary in most cases)
appExcel.Application.ScreenUpdating = True
appExcel.Application.DisplayAlerts = True
Set workSheet = appExcel.Worksheets("ExactActive")
workSheet.Range("A1:AX65000").Font.Size = 7.5
workSheet.Range("A1:B1").Interior.ColorIndex = 22
workSheet.Range("A2:B65000").Interior.ColorIndex = 22
workSheet.Range("C1:M1").Interior.ColorIndex = 4
workSheet.Range("C2:M65000").Interior.ColorIndex = 19
workSheet.Range("N1:T1").Interior.ColorIndex = 37
workSheet.Range("N2:T65000").Interior.ColorIndex = 20
workSheet.Range("U1:AB1").Interior.ColorIndex = 39
workSheet.Range("U2:AB65000").Interior.ColorIndex = 24
workSheet.Range("AC1:AD1").Interior.ColorIndex = 43
workSheet.Range("AC2:AD65000").Interior.ColorIndex = 35
workSheet.Range("AE1:AF1").Interior.ColorIndex = 4
workSheet.Range("AE2:AF65000").Interior.ColorIndex = 19
workSheet.Range("AG1:AJ1").Interior.ColorIndex = 43
workSheet.Range("AG2:AJ65000").Interior.ColorIndex = 35
workSheet.Range("AK1:AL1").Interior.ColorIndex = 39
workSheet.Range("AK2:AL65000").Interior.ColorIndex = 24
workSheet.Range("AM1:AM1").Interior.ColorIndex = 4
workSheet.Range("AM2:AM65000").Interior.ColorIndex = 19
workSheet.Cells.EntireColumn.AutoFit
With workSheet
workSheet.Range("A1:AM65000").Font.Size = 7#
workSheet.Range("C1:C65000").ColumnWidth = 18 'PSNo'
workSheet.Range("D165000").ColumnWidth = 20 'VndrItmID'
workSheet.Range("E1:E65000").ColumnWidth = 3 'UOM'
workSheet.Range("F1:F65000").ColumnWidth = 12 'NewPrice'
workSheet.Range("G1:G65000").ColumnWidth = 10 'VendorNo'
workSheet.Range("H1:H65000").ColumnWidth = 15 'VendorName'
workSheet.Range("I1:I65000").ColumnWidth = 5 'Location'
workSheet.Range("J1:J65000").ColumnWidth = 5 'Dflt UOM'
workSheet.Range("K1:K65000").ColumnWidth = 10 'Diff'
workSheet.Range("L1:L65000").ColumnWidth = 7 'UOMFlg'
workSheet.Range("M1:M65000").ColumnWidth = 7 'CnvFlg'
workSheet.Range("N1:N65000").ColumnWidth = 5 'IM-->'
workSheet.Range("O1:R65000").ColumnWidth = 7 'IMaster data'
workSheet.Range("S1:T65000").ColumnWidth = 10 'IMaster data'
workSheet.Range("U1:AB65000").ColumnWidth = 10 'IMaster data'
workSheet.Range("AC1:AH65000").ColumnWidth = 10 'IMaster data'
workSheet.Range("AE1:AF65000").ColumnWidth = 9 'IMaster data'
workSheet.Range("AI1:AJ65000").ColumnWidth = 30 'IMaster data'
With xlsheet1
workSheet.Range("C1:G65000").Font.Bold = True
workSheet.Range("C2:G65000").Font.ColorIndex = 51 'deep green'
workSheet.Range("K1:M65000").Font.Bold = True
workSheet.Range("K1:M65000").Font.ColorIndex = 3
workSheet.Range("K1:M65000").Font.Size = 8#
workSheet.Range("N1:N65000").Font.Bold = True
workSheet.Range("P1:T65000").Font.Size = 8#
workSheet.Range("P1:T65000").Font.Bold = True
workSheet.Range("P2:T65000").Font.ColorIndex = 53
workSheet.Range("U1:AB65000").Font.Size = 8.5
workSheet.Range("U1:AB65000").Font.Bold = True
workSheet.Range("U2:AB65000").Font.ColorIndex = 53
workSheet.Range("AE1:AF65000").Font.Size = 8#
workSheet.Range("AE1:AF65000").Font.Bold = True
workSheet.Range("AE2:AF65000").Font.ColorIndex = 53
workSheet.Range("AM1:AM65000").Font.Size = 8#
workSheet.Range("AM1:AM65000").Font.Bold = True
workSheet.Range("AM2:AM65000").Font.ColorIndex = 53
End With
End With
With workSheet
.Range("A1:AP1").AutoFilter
End With
'------------------ Remove Blank Rows --------------------------------------------------'
With workSheet
.Range("A1:AP65000").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42), Header:=xlYes
End With
Set dbs = Nothing
MsgBox "Done"
End Sub