Automatisk justering af feltbredde

Jeg bruger docmd.transferSpreadsheet i nedenstående script til at eksportere indholdet fra en tabel til ca. 40 regneark. Det virker fint, men kan man på nogen simpel måde justere kolonnebredden i excel så hele indholdet i de enkelte felter ses. Yderligere kunne jeg godt tænke mig at det man skriver ud fra excel, udskrives med rammer/skelet. Grunden til at jeg skriver så mange regneark ud er at de skal sendes pr. mail og man skal kunne se hvem (dvs. organisationsnavnet) de skal sendes til på filnavnet.

Sub eksportToExcel()

    Dim cn As ADODB.Connection
    Dim rsInst As ADODB.Recordset
    Dim rsInstUsers As ADODB.Recordset
    Dim rsInstBrugere As ADODB.Recordset
   
    Dim strSQL As String
    Dim strFileName As String
   
    Set rsInst = New ADODB.Recordset
    Set rsInstUsers = New ADODB.Recordset
    Set rsInstBrugere = New ADODB.Recordset
     
    Set cn = New ADODB.Connection
    Set cn = CurrentProject.Connection
   
    rsInst.Open "qryRapportgrundlagTilBrugerOprydningInstitutioner", cn, adOpenKeyset, adLockOptimistic
    cnt = 1

    Do Until rsInst.EOF

        strSQL = "SELECT qryRapportgrundlagTilBrugerOprydning.[CPR Nummer], qryRapportgrundlagTilBrugerOprydning.Brugernavn, qryRapportgrundlagTilBrugerOprydning.Fornavn, qryRapportgrundlagTilBrugerOprydning.Efternavn, qryRapportgrundlagTilBrugerOprydning.Afdelingsnavn FROM qryRapportgrundlagTilBrugerOprydning WHERE (((qryRapportgrundlagTilBrugerOprydning.Institutionsnavn) Like '" & rsInst![Institutionsnavn] & "'));"
        rsInstUsers.Open strSQL, cn, adOpenKeyset, adLockOptimistic
        rsInstBrugere.Open "tblBrugere", cn, adOpenKeyset, adLockOptimistic
       
        Do Until rsInstUsers.EOF
            rsInstBrugere.AddNew
           
            rsInstBrugere![CPRNummer] = rsInstUsers![CPR Nummer]
            rsInstBrugere![Brugernavn] = rsInstUsers![Brugernavn]
            rsInstBrugere![Fornavn] = rsInstUsers![Fornavn]
            rsInstBrugere![Efternavn] = rsInstUsers![Efternavn]
            rsInstBrugere![Afdeling] = rsInstUsers![Afdelingsnavn]
            rsInstBrugere![Status] = ""
           
            rsInstBrugere.MoveNext
            rsInstUsers.MoveNext
        Loop
       
        strFileName = "c:\" & CStr(rsInst![Institutionsnavn]) & ".xls"
       
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "tblBrugere", strFileName
        rsInstBrugere.Close
        rsInstUsers.Close
        DoCmd.SetWarnings False
        DoCmd.RunSQL "DELETE FROM tblBrugere;"
        DoCmd.SetWarnings True
        rsInst.MoveNext
    Loop

    rsInst.Close
    cn.Close
               
End Sub