Format Query in Excel

[racer25]

Hi,

I have the following code that takes a query with lots of Brokers and creates an Excel file for each Broker.

Private Sub Command0_Click()
Dim rs As DAO.Recordset
Dim sql As String
Dim strPath As String
strPath = "C:\Temp\"
sql = "SELECT DISTINCT Query.Broker FROM Query;"
Set rs = CurrentDb().OpenRecordset(sql, dbOpenSnapshot)
Do While Not rs.EOF
    strBrokerCode = rs!Broker
    DoCmd.OutputTo acOutputQuery, "Output", acFormatXLS, strPath & strBrokerCode & ".xls", False, "", 0, acExportQualityPrint
    rs.MoveNext
Loop
Set rs = Nothing
End Sub

Its largely copied from other code and tailored to work for my needs.

I am using Access 2007 to Office 2007.

What I would like to do extra is format each of the 350+ Excel files to auto-width the columns. Is their a template file I can use or additional code I can add to the above that will do this for me?

Thanks in advance for anything that you can offer.

 

[namliam]

No, templates wont work...

You will have to open the created document in excel and do the auto width thing in code. Have a search on the forum and see how far you can get...

 

[racer25]

Hi

Thanks for looking at this.

I know hw to do the code in Excel problem is opening the 350 files running the code close saving etc. etc. Have I misunderstood your suggestion ?

Cheers,

R

 

[namliam]

Yes that is exactly the problem and no real good way around it, unfortunatly....

And no need to code it seperately in Excel you can do it right from Access right at the time you export the file.

 

[racer25]

Hi,

Struggling with this but getting somewhere.....

Private Sub Command0_Click()
Dim rs As DAO.Recordset
Dim sql As String
Dim strPath As String
Dim notesdb As Object
Dim notesdoc As Object
Dim notesrtf As Object
Dim notessession As Object
Dim strSupportEMail As String
Dim avarattach(3) As Variant
Dim stDocName As String
Dim ApXL As Object
Dim workBook As Object
Dim Worksheets As Object


strPath = "C:\Temp\DebtCollection\"
sql = "SELECT DISTINCT Query.Broker, Query.Salutation, Query.ContactEmail FROM Query;"
Set rs = CurrentDb().OpenRecordset(sql, dbOpenSnapshot)
Do While Not rs.EOF
    strBrokerCode = rs!Broker
    Email = rs!ContactEmail
    Salutation = rs!Salutation
    
    DoCmd.OutputTo acOutputQuery, "Output", acFormatXLS, strPath & strBrokerCode & " - Debtors List.xls", False, "", 0, acExportQualityPrint
    
Set ApXL = CreateObject("Excel.Application")
With ApXL
.Application.Visible = False
.UserControl = False
.Workbooks.Open strPath & strBrokerCode & " - Debtors List.xls"
       
       
    .Columns("A:A").ColumnWidth = 7.5
    .Columns("B:B").ColumnWidth = 8.9
    .Columns("C:C").ColumnWidth = 33
    .Columns("D:K").Select
    .Selection.ColumnWidth = 12.1

    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup

        .CenterFooter = "&F"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.196850393700787)
        .RightMargin = Application.InchesToPoints(0.196850393700787)
        .TopMargin = Application.InchesToPoints(0.196850393700787)
        .BottomMargin = Application.InchesToPoints(0.393700787401575)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.196850393700787)
    End With
    
    .Range("A1").Select
    .ActiveWorkbook.Save
    .ActiveWorkbook.Close
    .Application.Quit

End With

    
    
    

'make new mail message
Set notessession = CreateObject("Notes.Notessession")
Set notesdb = notessession.GetDatabase("", "")
Call notesdb.OPENMAIL
Set notesdoc = notesdb.CreateDocument
Call notesdoc.replaceitemvalue("Sendto", Email)
Call notesdoc.replaceitemvalue("Subject", " Debtors List - " & strBrokerCode & " " & Format(Now(), "dd-mmm-yy") & ".")
Set notesrtf = notesdoc.CreateRichTextItem("body")
Call notesrtf.AppendText("Dear " & Salutation & ",")
Call notesrtf.AddNewLine(2)
Call notesrtf.AppendText("Please find attached your Debtors List as at " & Format(Now(), "dd-mmm-yy") & ".")
Call notesrtf.AddNewLine(2)
Call notesrtf.AppendText("The File - Guidelines.doc - contains instructions from ******* regarding your list.")
Call notesrtf.AddNewLine(2)
Call notesrtf.AppendText("The file is in Excel which may assist with keeping a record of calls to clients.")
Call notesrtf.AddNewLine(2)
avarattach(0) = "C:\Temp\DebtCollection\" & strBrokerCode & " - Debtors List.xls"
Call notesrtf.EmbedObject(1454, "", avarattach(0), "Attachment")
Call notesrtf.AddNewLine(2)
avarattach(1) = "C:\Temp\DebtCollection\Guidelines.doc"
Call notesrtf.EmbedObject(1454, "", avarattach(1), "Attachment")
Call notesrtf.AddNewLine(2)
Call notesrtf.AppendText("Kind Regards")
Call notesrtf.AddNewLine(2)
Call notesrtf.AppendText("Robert Webb")
Call notesrtf.AddNewLine(1)
Call notesrtf.AppendText("Finance Dept")
Call notesrtf.AddNewLine(1)

Call notesrtf.AppendText("________________________________________________________________________________")

strSupportEMail = "*********"
notesdoc.SaveMessageOnSend = True
'Call notesdoc.Send(True) 'Send the email!
Call notesdoc.Save(True, False)   '// This saves the e-mail in the "Draft" Folder
Set notessession = Nothing
    
rs.MoveNext
  
Loop

Set rs = Nothing

End Sub

I tried copying in Excel code and it fails at " .LeftMargin = Application.InchesToPoints(0.196850393700787)"

My goal is to have page rotate to Landscape, set the margins and then fit to 1 page wide by Many tall.

Hope you can point me in the right direction...

Thanks

Rob

 

[namliam]

strSupportEMail = <<== Did you leave your actual email in here??? Better delete it ASAP or be spammed to death.

I tried copying in Excel code and it fails at " .LeftMargin = Application.InchesToPoints(0.196850393700787)"

Offcourse if fails here, you are executing this from access right?

Therefor Application refers to Access and that doesnt know InchesToPoints.
Maybe it will work if you change application to the ApXL

 

[racer25]

Thanks for the heads up on email address - having a bad day.

Forgive the dumb questions - I have been reading lots and lots of examples trying to piece this together and admittedly not all of it I understand.

Why would .Columns("A:A").ColumnWidth = 7.5 work and
.LeftMargin = Application.InchesToPoints(0.196850393700787) not work

I am trying to figure it out and for the life of me stumped.

Thanks for your help and pointers so far.

 

[chergh]

"inchestopoints" is a method of the excel application object, the access application object doesn't have this method, that is why it fails. When you write "application" like that in your code it points at the access application object and you are wanting to use the excel application object. Try replacing it with:

.LeftMargin = ApXL.InchesToPoints(0.196850393700787)

Or exactly as namliam said now that I have just read his response.

 

[namliam]

Why would .Columns("A:A").ColumnWidth = 7.5 work and
.LeftMargin = Application.InchesToPoints(0.196850393700787) not work

Despite your bad day... try re-reading my post ...

Application refers to the application that is executing the code.... If you use Application.InchesToPoints in Excel that will work fine... as the application Excel knows that.

However if you execute Application in Access.... Access doesnt know it, so inside access you have to refer to ApXL in order for it to work

The .Columns("A:A").ColumnWidth = 7.5 works fine, because for the full line you have to include the With above it.

ApXL.Columns("A:A").ColumnWidth = 7.5
Thusly this part, ApXL.LeftMargin, does work... its the 'other', Application, part that is failing on you.