Exporting to Excel .xlsx (1 Viewer)

[sdell]

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

 

[theDBguy]

Hi. Are you getting any errors with the formatting code?

 

[sdell]

No. Just doesn't format.

 

[theDBguy]

No. Just doesn't format.

Ah, in that case, you may have to step through the code to see what is happening.

 

[The_Doc_Man]

You have three sequences that could be referred to as "formatting" - one for color index, one for column widths, and one for font alteration. Do ANY of them work or do all three sequences fail?

 

[sdell]

Non of the formatting is working.
What appears in another piece of code is an addt'l blank workbook opens while the main workbook opens.
Kinda of strange. Is there code to suppress the blank workbook.

 

[The_Doc_Man]

You have some color-background changes as part of the formatting. Check whether that formatting has occurred in the other workbook.

 

[Darrell]

Hi, Can you try changing

Set workSheet = appExcel.Worksheets("ExactActive")

to

Set workSheet = workBook.Sheets("ExactActive")

Also, I'm not sure what 'With xlsheet1' is referring to as you don't have this sheet mentioned anywhere else...

 

[The_Doc_Man]

Not that it makes a difference to the question, but...

With workSheet
workSheet.Range("A1:AM65000").Font.Size = 7#

workSheet.Range("C1:C65000").ColumnWidth = 18 'PSNo'
workSheet.Range("D1:D65000").ColumnWidth = 20 'VndrItmID'
workSheet.Range("E1:E65000").ColumnWidth = 3 'UOM'
...

You could probably save yourself some typing by omitting the "worksheet" references I highlighted in red. The WITH clause should cover them.

As to the main problem, it's actually pretty simple. Either the formatting changes you made went nowhere because you have some reference defined incorrectly or they went somewhere - the WRONG somewhere - because you have some reference defined incorrectly. That's why I suggested that you look in the other workbook you mentioned earlier.