UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
2 Pages V < 1 2  (Go to first unread post)
   Reply to this topicStart new topic
> VBA Loop - Need A Qry To Run For Each Name In A Table Field, Any Version    
 
   
starleyrover
post Jun 2 2017, 10:01 AM
Post#21



Posts: 17
Joined: 24-April 17



Dennis, apologies for my ongoing dimness. Yes, those two columns fail to populate (Clinic, Age). I have implemented your suggestions, as I step through the code, the missing data items (name , age) appear (under intCol1 & intCol3) but again fail to appear in the Excel output. Written in haste as I need to dash for a train. Hope to return to this on Monday. Best wishes. Mark
Go to the top of the page
 
doctor9
post Jun 2 2017, 10:07 AM
Post#22


UtterAccess Editor
Posts: 17,849
Joined: 29-March 05
From: Wisconsin


starleyrover,

> as I step through the code, the missing data items (name , age) appear (under intCol1 & intCol3) but again fail to appear in the Excel output.

Okay, so as the line of code is highlighted, what are the values of intFirstRow, intRow, intFirstCol and intCol? Maybe the data is being written somewhere unexpected. If rst.Fields(intCol) shows a value, and you hit F8 once, that value SHOULD appear in the cell specified by those four values.

Hope this helps,

Dennis

--------------------
(;,;) Li'l Cthulu says: Please talk about what you're trying to do, as well as how you're doing it.
Changing your real table name to "Table1" and your real form name to "Form1" in your posts makes it more difficult to understand what's going on, not easier.
Guidelines for Posting Questions
Go to the top of the page
 
starleyrover
post Jun 5 2017, 05:43 AM
Post#23



Posts: 17
Joined: 24-April 17



Dennis
That was a great help. I was incrementing a loop that was already doing so as part of the For Next ('intCol = intCol + 1). And that's why I was skipping columns in my output.
To save and close Excel
CODE
xlApp.ActiveWorkbook.Save
xlApp.ActiveWorkbook.Close
xlApp.Quit

Other points that may help others avoid pitfalls: I needed to select MS Excel 14.0 Object Library and MS DAO 3.6 Object Library (Tools, References from VBA window).
I cannot begin to express how grateful I am for your patience and guidance. These techniques of using recordsets and query defs are key to me taking control of a fairly complex project. As a result, I am feeling much more confident about things.
Thanks again
Mark
CODE
Public Sub ExcelList50()

    Dim dbs As DAO.Database, rst As DAO.Recordset, rsTarget As DAO.Recordset
    Dim strSQL, strSQLTarget, strFolder, strTargetFile As String
    Set dbs = CurrentDb
    
    strFolder = "Q:\HPV\Projects - Post immunisation\MSM Implementation and Project Board\Uptake\Outputs\Tables\Export\"
      
'   GUMCAD key field is a five character string
    strSQL = "SELECT gumcad, clinicname FROM tlkpGUMCAD"
    
    Set rst = dbs.OpenRecordset(strSQL)
    
    rst.MoveFirst
    'DoCmd.SetWarnings (WarningsOff)
    'Do While rst!gumcad = "5MX16" ' single clinic while debugging
    Do While Not rst.EOF
        'Debug.Print rst!gumcad
        strSQLTarget = "SELECT TOP 50 tblGUMCADNoHPVCode.gumcad, tblGUMCADNoHPVCode.clinicname as Clinic, " & _
        "tblGUMCADNoHPVCode.patient_id, tblGUMCADNoHPVCode.MinOfage as Age, tblGUMCADNoHPVCode.outcome " & _
        "FROM tblGUMCADNoHPVCode WHERE tblGUMCADNoHPVCode!GUMCAD = '" & rst!gumcad & "'" & _
        " ORDER BY tblGUMCADNoHPVCode.random DESC;"
        'Debug.Print strSQLtarget
        
        
        Set rsTarget = dbs.OpenRecordset(strSQLTarget)

        strTargetFile = strFolder & Trim(rst!clinicname) & ".xlsx"
        FileCopy strFolder & "AuditProforma.xlsx", strTargetFile
        ' Call subroutine to open Excel file and write range
        WriteRecordsetToExcelRange strTargetFile, "Audit", "A7", rsTarget
        rst.MoveNext
     Loop
    
'   Cleanup
    'DoCmd.SetWarnings (WarningsOn)
    rst.Close
    rsTarget.Close
    dbs.Close
    Set rst = Nothing
    Set rsTarget = Nothing
    Set dbs = Nothing

End Sub
'   This next subroutine belongs in a new code module, not one attached to a form or report.
Public Sub WriteRecordsetToExcelRange(strFilename As String, _
                                      strSheetName As String, _
                                      strFirstCell As String, _
                                      rst As DAO.Recordset)
    
    'Declare variables
    Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim intRow As Integer, intCol As Integer
    Dim intFirstRow As Integer, intFirstCol As Integer
    
'   No records to process?  Abort.
    If rst.RecordCount = 0 Then Exit Sub
    
    'Open Excel File to modify
    Set xlApp = CreateObject("Excel.Application")
    'xlApp.Visible = True
    xlApp.Workbooks.Open strFilename, False, False
    
    'Define the Excel worksheet to export records to
    Set xlSheet = xlApp.Worksheets(strSheetName)
    
    intFirstCol = xlSheet.Range(strFirstCell).Column
    intFirstRow = xlSheet.Range(strFirstCell).Row
    
    rst.MoveFirst
    intRow = 0
    'xlApp.DisplayAlerts = False 'IT WORKS TO DISABLE ALERT PROMPT
    'Loop recordset and export each record to new row in Excel worksheet
    Do Until rst.EOF
        For intCol = 0 To rst.Fields.Count - 1
            xlSheet.Cells(intFirstRow + intRow, intFirstCol + intCol) = rst.Fields(intCol)
            'intCol = intCol + 1
        Next intCol
        intRow = intRow + 1
        rst.MoveNext
        
    Loop
    
'   Cleanup
    xlApp.ActiveWorkbook.Save
    xlApp.ActiveWorkbook.Close
    xlApp.Quit
    'xlApp.DisplayAlerts = True 'RESETS DISPLAY ALERTS
    Set xlSheet = Nothing
    Set xlApp = Nothing
    
End Sub
Go to the top of the page
 
2 Pages V < 1 2


Custom Search
RSSSearch   Top   Lo-Fi    19th November 2017 - 04:17 PM