VBA to Loop Through Access Table and Place in Excel...PT II

[jhabey01]

The Following Code Works Perfectly... It takes Data from a Table and loops through the table and based on Group (Group is a Company Name) saves it in the specified folder. In this table (TA_Accident_NewEnrollment) I also have a field called State. What I want to do next is using the TA_Accident_NewEnrollment table loop through the table where the state is NY and Name the files TA_Accident_NewEnrollment_NY and then go through it loop again and where the state is Not NY and Name the files TA_Accident_NewEnrollment_NY.

I still want to keep the Groups (Companies) in separate files though.

I could just create another table and put non Ny enrollments in the table and recreate the code based off that table but I thought I would see if I could do the above first. Thanks for checking this out>


Private Sub New_Accident_Click()
'1
On Error GoTo HandleError:

'ExportStuff = True

Dim intMouseType As Integer
Dim strErrorMsg As String
Dim varReturn As Variant
Dim strFolderName As String
Dim strFileName As String
Dim strOutputPath As String
Dim strTemplateName As String
Dim strTemplatePath As String
Dim objFSO As Object
Dim strCompanyName As String
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
Dim intStartRow As Integer
Dim strSQLData As String
Dim objXLApp As Object
Dim objXLBook As Object
Dim objXLMainSheet As Object
Dim rstData As DAO.Recordset

intMouseType = Screen.MousePointer

DoCmd.Hourglass True

Set db = CurrentDb

Set objFSO = CreateObject("Scripting.FileSystemObject")

'
intStartRow = 12

strTemplatePath = "R:\Admin Services\Reporting\TA\TAWorksheets\"
strTemplateName = "TA_Accident.xlsm"
strOutputPath = "R:\Admin Services\Reporting\TA\TACompletedEnrollments\"
strSQL = "select distinct [GroupName] from TA_Accident_NewEnrollment"

Set rst = db.OpenRecordset(strSQL)

'Now need to get a copy of the file
Do While Not rst.EOF
'strCompanyName = rst.Fields("GroupName").Value
strCompanyName = Replace(rst.Fields("GroupName").Value, ",", "")
strFileName = strOutputPath & "TA_Accident_NewEnrollment_" & strCompanyName & ".xlsm"

'Delete if it exists
If objFSO.FileExists(strOutputPath & "TA_Accident_NewEnrollment_" & strCompanyName & ".xlsm") Then
objFSO.deletefile strOutputPath & "TA_Accident_NewEnrollment_" & strCompanyName & ".xlsm"
End If

'Get new file
objFSO.copyfile strTemplatePath & strTemplateName, strOutputPath & "TA_Accident_NewEnrollment_" & strCompanyName & ".xlsm"

'Now get recordset
'swap these around - build SQL string before opening recordset
strSQLData = "select * from TA_Accident_NewEnrollment where Replace([GroupName],',','') = '" & strCompanyName & "'"
Set rstData = db.OpenRecordset(strSQLData)


'
'rstData = db.OpenRecordset(strSQLData)
' rstData = db.OpenRecordset(strSQLData)

Set objXLApp = CreateObject("Excel.Application")

'Make it non visible. Speeds it up
objXLApp.Application.Visible = True

'Coop - 20/11/2014 - turn off events, so the file isnt looking for an ini file that isnt there yet.
objXLApp.EnableEvents = False

'This name is differnt than the one above. - strOutputPath & "TA_NewEnrollment_" & strCompanyName & ".xlsm"
Set objXLBook = objXLApp.Workbooks.Open(strOutputPath & "TA_Accident_NewEnrollment_" & strCompanyName & ".xlsm", False, False)

‘
Set objXLMainSheet = objXLBook.Worksheets("CI Advance_Acc Adv_LL")

'Set some values on the main sheet
With objXLMainSheet
'.Cells(4, 1) = "Processed " & Format(Now(), "ddd, dd mmm, yyyy hh:nn:ss AM/PM")
'need to tell it what recordset to use
.Cells(intStartRow + 1, 1).CopyFromRecordset rstData
If .Range("bc13").Value <> "HealthAlliance" Then
.Range("C4").Value = .Range("bD13")
.Range("c6").Value = .Range("bC13")
.Range("BC13:BE500").Value = ""
.Range("C8").Value = "D000000001"
.Range("H8").Value = "Voluntary"

.Range("A12").Select

End If
objXLBook.Save
objXLBook.Close
End With

rst.MoveNext
Loop

ExitHere:
On Error Resume Next
'Close all recordsets etc here
varReturn = SysCmd(acSysCmdClearStatus)
Screen.MousePointer = intMouseType
objXLApp.Close
Set objXLApp = Nothing
Set objXLBook = Nothing
rstData.Close
Set rstData = Nothing
Exit Sub


HandleError:

Resume ExitHere


MsgBox "Process Complete..."
End Sub

 

[SkipVought]

Hi,

I don't understand what it is you need to do that isn't being performed???

 

[jhabey01]

Sure, currently the code loops through the table and for each Group Name (a group is considered a company name) in that table (I could have many Company's in the table) So the code loops through the each group and copies all the data for that group into its own excel file.
...this works perfectly. (I think you helped me to get it to this point. Thanks)
I want to take this a step further. The data also contains a field called State and the table could have many states. (as in NY, MA, CA, etc) I want to have the code continue doing what it is doing but loop through ny not only Group but by State as well.
So suppose I have the following in the Accident table. Each row of data is a members enrollment information for that group and a member could live outside NY.
Group Policy BenefitAmt State
Goudly Accident 500 NY
Forseth Accident 500 NY
Goudly Accident 60000 CT
Winkerstein Accident 500 NY

The Code currently take all 3 groups and places each group into its own Accident Enrollment excel file.
Now I want to not only separate the files by Group but by State (with the only two options being NY and NonNY)
The result woutl be Two files for Goudly, One file for Forseth and one for Winkerstein.

I want to take Goudly and Forseth and put in a file and save it as somthing like: Goudly_Accident_NY_Enrollment_Date (this is the NY enrollment) and Goudly_Accident_NonNY_Enrollment_Date (for the NonNY enrollment)
The other two files would be named Forseth_Accident_NY_Enrollment and Winkerstein_Accident_Ny_Enrollment
Then I want to take Wikerstein and save it to its own Accident enrollment file called: GroupName_Accident_NonNY_Enrollment_Date. Instead of One file I am no

 

[SkipVought]

For NY

strSQLData = "select * from TA_Accident_NewEnrollment where Replace([GroupName],',','') = '" & strCompanyName & "' and [State]='NY'"

for Not NY

strSQLData = "select * from TA_Accident_NewEnrollment where Replace([GroupName],',','') = '" & strCompanyName & "' and [State]<>'NY'"

 

[jhabey01]

Thanks for the post