从 Access 将组合框值输出到 Excel
Outputting combobox values to Excel from Access
我正在尝试将 Access 中组合框字段的值作为字符串输出到 Excel 工作sheet。
我尝试了几次 solutions/hacks 并得到 445 个错误。
组合框是成员服务的社区或人群的下拉列表（例如男同性恋者、老龄化人群、跨性别者*、有色人种、原住民群体、女性、新加拿大人等）。可以选几个，还有一些空白记录。
Sub OutputSub()
' Define a recordset for the Table I am using
Dim myConnection As ADODB.Connection
Set myConnection = CurrentProject.Connection
Dim myRecordset As New ADODB.Recordset
myRecordset.ActiveConnection = myConnection
myRecordset.Open "MemberList", , adOpenStatic, adLockOptimistic
' Open Excel and make a worksheet for me
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
' Make Excel visible through the Application object.
xlSheet.Application.Visible = True
' Variables for each of the values I will need
Dim memCom As Variant, memServ As Variant, memLangs As Variant, memTot As Variant
Dim memNum As Integer
memNum = 2
xlSheet.Application.Cells(1, 4).Value = "Services"
'This loops through each of the records in the Table MemberList
myRecordset.MoveFirst
Do Until myRecordset.EOF()
memCom = myRecordset.Fields("Communities Served")
' This next line causes a 1004 error, application or object defined error
xlSheet.Application.Cells(memNum, 4).Value = memCom
'Debug.Print memCom, memServ, memLangs
memNum = memNum + 1
myRecordset.MoveNext
Loop
' Cleanup open files/variables, just in case
myRecordset.Close
Set myRecordset = Nothing
Set myConnection = Nothing
End Sub
我的目标是 Excel sheet，其值与我将数据库导出为 Excel 文件非常相似。我需要特定格式的前三列信息（我正在处理，所以我把它们删掉了）。
我从 Whosebug 中发现了很少关于如何访问组合框的值的信息，以及关于如何向框中添加字段的很多提示。
更新：运行时错误 1004：发生应用程序定义或对象定义错误，如代码中注释所示。
更新 2：进一步挖掘从 Office 开发中心得到了这个：https://social.msdn.microsoft.com/Forums/office/en-US/f5de518d-a2f0-41b8-bfd3-155052547ab5/export-of-combo-box-to-excel-with-values-access-2010?forum=accessdev。
我创建了一个查询，它将使用 memName 输出我需要的信息，但我不知道如何使它成为此输出的一部分。
如果您单步执行程序是哪一行导致了错误 - 这是进行故障排除的第一步
字段 "Communities Served" 的值是多少？它是一个逗号分隔的字符串，您想分成多列 - 或者只是用任何结果填充一次单元格 - 这就是我的样子？
无论如何，通过更改
来消除您的错误
xlSheet.Application.Cells(memNum, 4).Value = memCom
到
xlSheet.Cells(memNum, 4).Value = memCom
EDIT - memCom is coming back as a array Use Debug Watch to look at
how you need to access the value - probably even as simple as
memcon(0)
感谢@dbmitch 和@Nathan_Sav 的帮助，他们帮我找出了问题所在，所以我可以修复它。
为了后代，为了防止其他人遇到此问题，解决方案是在 Access 中查询我的多值组合框，然后将该查询的值放入记录集中。然后我必须列出查询 returned 的值，然后 return 将该列表放入我的 excel sheet.
这是我的代码：
Sub OutputSub()
' Define a recordset for the Table I am using
Dim myConnection As ADODB.Connection
Set myConnection = CurrentProject.Connection
Dim myRecordset As New ADODB.Recordset
myRecordset.ActiveConnection = myConnection
myRecordset.Open "MemberList", , adOpenStatic, adLockOptimistic
'Define a recordset for the query into my services
Dim myConnection2 As ADODB.Connection
Set myConnection2 = CurrentProject.Connection
Dim myServicesRecordset As New ADODB.Recordset
myServicesRecordset.ActiveConnection = myConnection2
myServicesRecordset.Open "SELECT MemberList.[Organization Name], MemberList.[Services Offered].Value FROM MemberList", , adOpenStatic, adLockOptimistic
' Open Excel and make a worksheet for me
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
' Make Excel visible through the Application object.
xlSheet.Application.Visible = True
' Variables for each of the values I will need
Dim memName As String, memSite As Variant
Dim memSoc As Variant, memNameHOLD
Dim memServ As Variant, memServHOLD As Variant, memServName As Variant
'Variable for the line in the database, and start it counting at 2, so there is space for Column headers
' Then give the column headers values.
Dim memNum As Integer
memNum = 2
xlSheet.Application.Cells(1, 1).Value = "Member Name"
xlSheet.Application.Cells(1, 4).Value = "Services"
'This loops through each of the records in the Table MemberList
myRecordset.MoveFirst
Do Until myRecordset.EOF()
' Sets the value of the variables to the content of the relevant field
memName = myRecordset.Fields("Organization Name")
memSite = myRecordset.Fields("Website")
'If there is content in the website field, then make the Org Name a link, else leave it as is.
If Not IsNull(memSite) Then
memNameHOLD = "<a href=" & memSite & ">" & memName & "</a>"
Else
memNameHOLD = memName
End If
'Collect the Services offered into a list for this memName
myServicesRecordset.MoveFirst
Do Until myServicesRecordset.EOF()
memServ = myServicesRecordset.Fields(1)
memServName = myServicesRecordset.Fields(0)
If memServName = memName Then
memServHOLD = memServHOLD & memServ & ", "
Else
memServHOLD = memServHOLD
End If
myServicesRecordset.MoveNext
memServ = ""
Loop
xlSheet.Application.Cells(memNum, 1).Value = memNameHOLD
xlSheet.Application.Cells(memNum, 3).Value = memRegion
xlSheet.Cells(memNum, 4).Value = "Services Offered: " & memServHOLD
memNum = memNum + 1
myRecordset.MoveNext
'Clear the hold value
memServHOLD = ""
Loop
' Cleanup open files/variables, just in case
myRecordset.Close
Set myRecordset = Nothing
Set myConnection = Nothing
End Sub
眼尖的人或许还能告诉我，如果没有值，输出中为什么会有,。但综合考虑，那个小逗号是可以接受的错误。
我正在尝试将 Access 中组合框字段的值作为字符串输出到 Excel 工作sheet。
我尝试了几次 solutions/hacks 并得到 445 个错误。
组合框是成员服务的社区或人群的下拉列表（例如男同性恋者、老龄化人群、跨性别者*、有色人种、原住民群体、女性、新加拿大人等）。可以选几个，还有一些空白记录。
Sub OutputSub()
' Define a recordset for the Table I am using
Dim myConnection As ADODB.Connection
Set myConnection = CurrentProject.Connection
Dim myRecordset As New ADODB.Recordset
myRecordset.ActiveConnection = myConnection
myRecordset.Open "MemberList", , adOpenStatic, adLockOptimistic
' Open Excel and make a worksheet for me
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
' Make Excel visible through the Application object.
xlSheet.Application.Visible = True
' Variables for each of the values I will need
Dim memCom As Variant, memServ As Variant, memLangs As Variant, memTot As Variant
Dim memNum As Integer
memNum = 2
xlSheet.Application.Cells(1, 4).Value = "Services"
'This loops through each of the records in the Table MemberList
myRecordset.MoveFirst
Do Until myRecordset.EOF()
memCom = myRecordset.Fields("Communities Served")
' This next line causes a 1004 error, application or object defined error
xlSheet.Application.Cells(memNum, 4).Value = memCom
'Debug.Print memCom, memServ, memLangs
memNum = memNum + 1
myRecordset.MoveNext
Loop
' Cleanup open files/variables, just in case
myRecordset.Close
Set myRecordset = Nothing
Set myConnection = Nothing
End Sub
我的目标是 Excel sheet，其值与我将数据库导出为 Excel 文件非常相似。我需要特定格式的前三列信息（我正在处理，所以我把它们删掉了）。
我从 Whosebug 中发现了很少关于如何访问组合框的值的信息，以及关于如何向框中添加字段的很多提示。
更新：运行时错误 1004：发生应用程序定义或对象定义错误，如代码中注释所示。
更新 2：进一步挖掘从 Office 开发中心得到了这个：https://social.msdn.microsoft.com/Forums/office/en-US/f5de518d-a2f0-41b8-bfd3-155052547ab5/export-of-combo-box-to-excel-with-values-access-2010?forum=accessdev。
我创建了一个查询，它将使用 memName 输出我需要的信息，但我不知道如何使它成为此输出的一部分。
如果您单步执行程序是哪一行导致了错误 - 这是进行故障排除的第一步
字段 "Communities Served" 的值是多少？它是一个逗号分隔的字符串，您想分成多列 - 或者只是用任何结果填充一次单元格 - 这就是我的样子？
无论如何，通过更改
来消除您的错误xlSheet.Application.Cells(memNum, 4).Value = memCom
到
xlSheet.Cells(memNum, 4).Value = memCom
EDIT - memCom is coming back as a array Use Debug Watch to look at how you need to access the value - probably even as simple as memcon(0)
感谢@dbmitch 和@Nathan_Sav 的帮助，他们帮我找出了问题所在，所以我可以修复它。
为了后代，为了防止其他人遇到此问题，解决方案是在 Access 中查询我的多值组合框，然后将该查询的值放入记录集中。然后我必须列出查询 returned 的值，然后 return 将该列表放入我的 excel sheet.
这是我的代码：
Sub OutputSub()
' Define a recordset for the Table I am using
Dim myConnection As ADODB.Connection
Set myConnection = CurrentProject.Connection
Dim myRecordset As New ADODB.Recordset
myRecordset.ActiveConnection = myConnection
myRecordset.Open "MemberList", , adOpenStatic, adLockOptimistic
'Define a recordset for the query into my services
Dim myConnection2 As ADODB.Connection
Set myConnection2 = CurrentProject.Connection
Dim myServicesRecordset As New ADODB.Recordset
myServicesRecordset.ActiveConnection = myConnection2
myServicesRecordset.Open "SELECT MemberList.[Organization Name], MemberList.[Services Offered].Value FROM MemberList", , adOpenStatic, adLockOptimistic
' Open Excel and make a worksheet for me
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
' Make Excel visible through the Application object.
xlSheet.Application.Visible = True
' Variables for each of the values I will need
Dim memName As String, memSite As Variant
Dim memSoc As Variant, memNameHOLD
Dim memServ As Variant, memServHOLD As Variant, memServName As Variant
'Variable for the line in the database, and start it counting at 2, so there is space for Column headers
' Then give the column headers values.
Dim memNum As Integer
memNum = 2
xlSheet.Application.Cells(1, 1).Value = "Member Name"
xlSheet.Application.Cells(1, 4).Value = "Services"
'This loops through each of the records in the Table MemberList
myRecordset.MoveFirst
Do Until myRecordset.EOF()
' Sets the value of the variables to the content of the relevant field
memName = myRecordset.Fields("Organization Name")
memSite = myRecordset.Fields("Website")
'If there is content in the website field, then make the Org Name a link, else leave it as is.
If Not IsNull(memSite) Then
memNameHOLD = "<a href=" & memSite & ">" & memName & "</a>"
Else
memNameHOLD = memName
End If
'Collect the Services offered into a list for this memName
myServicesRecordset.MoveFirst
Do Until myServicesRecordset.EOF()
memServ = myServicesRecordset.Fields(1)
memServName = myServicesRecordset.Fields(0)
If memServName = memName Then
memServHOLD = memServHOLD & memServ & ", "
Else
memServHOLD = memServHOLD
End If
myServicesRecordset.MoveNext
memServ = ""
Loop
xlSheet.Application.Cells(memNum, 1).Value = memNameHOLD
xlSheet.Application.Cells(memNum, 3).Value = memRegion
xlSheet.Cells(memNum, 4).Value = "Services Offered: " & memServHOLD
memNum = memNum + 1
myRecordset.MoveNext
'Clear the hold value
memServHOLD = ""
Loop
' Cleanup open files/variables, just in case
myRecordset.Close
Set myRecordset = Nothing
Set myConnection = Nothing
End Sub
眼尖的人或许还能告诉我，如果没有值，输出中为什么会有,。但综合考虑，那个小逗号是可以接受的错误。