いくつかの VBA を理解するだけです (これは私にとって初めてのことなので、ご容赦ください!)
クエリContactDetails_SurveySoftOutcomesから、最初にそのクエリのDeptNameフィールドにあるすべての一意の値のリストを見つけようとしているため、 rsGroup
Dim はDeptNameフィールドにグループ化されたクエリを格納しています。
次に、このグループ化されたリストを使用して、同じクエリを再度循環しますが、一意の各エントリをレコードセット全体のフィルターとして渡し、フィルター処理された各レコードセットを独自の Excel スプレッドシートにエクスポートします...Do While Not
ループを参照してください。
DoCmd.TransferSpreadsheet
私のコードは...rsExport
の部分でつまづいています。私はこれに少しrsExport
慣れていませんが、レコードセットの Dim 名はこの方法では受け入れられないと思います..?
既に開始したコードを簡単に修正する方法はありますか?それとも、これをすべて達成するためにまったく別のアプローチを使用する必要がありますか?
コード:
Public Sub ExportSoftOutcomes()
Dim rsGroup As DAO.Recordset
Dim Dept As String
Dim myPath As String
myPath = "C:\MyFolder\"
Set rsGroup = CurrentDb.OpenRecordset("SELECT ContactDetails_SurveySoftOutcomes.DeptName " _
& "FROM ContactDetails_SurveySoftOutcomes GROUP BY ContactDetails_SurveySoftOutcomes.DeptName", dbOpenDynaset)
Do While Not rsGroup.EOF
Dept = rsGroup!DeptName
Dim rsExport As DAO.Recordset
Set rsExport = CurrentDb.OpenRecordset("SELECT * FROM ContactDetails_SurveySoftOutcomes " _
& "WHERE (((ContactDetails_SurveySoftOutcomes.DeptName)='" & Dept & "'))", dbOpenDynaset)
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, rsExport, myPath & Dept & "\" & Dept & " - Soft Outcomes Survey.xls", True
rsGroup.MoveNext
Loop
End Sub
固定コード:
Public Sub ExportSoftOutcomes()
Dim rsGroup As DAO.Recordset
Dim Dept As String
Dim myPath As String
myPath = "C:\MyFolder\"
Set rsGroup = CurrentDb.OpenRecordset("SELECT ContactDetails_SurveySoftOutcomes.DeptName " _
& "FROM ContactDetails_SurveySoftOutcomes GROUP BY ContactDetails_SurveySoftOutcomes.DeptName", dbOpenDynaset)
Do While Not rsGroup.EOF
Dept = rsGroup!DeptName
Dim rsExportSQL As String
rsExportSQL = "SELECT * FROM ContactDetails_SurveySoftOutcomes " _
& "WHERE (((ContactDetails_SurveySoftOutcomes.DeptName)='" & Dept & "'))"
Dim rsExport As DAO.QueryDef
Set rsExport = CurrentDb.CreateQueryDef("myExportQueryDef", rsExportSQL)
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "myExportQueryDef", myPath & Dept & "\" & Dept & " - Soft Outcomes Survey.xls", True
CurrentDb.QueryDefs.Delete rsExport.Name
rsGroup.MoveNext
Loop
End Sub