Copy List Box Content To Another List Box\Combo Box

'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 2 List Boxes, 1 Combo Box and 2 Command Buttons to your form.
'Add few Items to List1. At Run-Time press the first button to copy List1 content to List2.
'And press The second button to copy List1 content to Combo1.

'Insert the following code to your module:

Public Declare Function SendMessageStr Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As String) As Long

Public Declare Function SendMessageLong Lib "user32" _
Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long

'Insert the following code to your form:

Private Sub Command1_Click()
Dim success As Long
success = CopyListToList(List1, List2)
End Sub

Private Sub Command2_Click()
Dim success As Long
success = CopyListToCombo(List1, Combo1)
If success Then Combo1.ListIndex = 0
End Sub

Private Function CopyListToList(source As ListBox, target As ListBox) As Long
Dim c As Long
Const LB_GETCOUNT = &H18B
Const LB_GETTEXT = &H189
Const LB_ADDSTRING = &H180

'get the number of items in the list

Dim numitems As Long
Dim sItemText As String * 255

'get the number of items in the source list

numitems = SendMessageLong(source.hWnd, LB_GETCOUNT, 0&, 0&)

'if it has contents, copy the items

If numitems > 0 Then
For c = 0 To numitems - 1
Call SendMessageStr(source.hWnd, LB_GETTEXT, c, ByVal sItemText)
Call SendMessageStr(target.hWnd, LB_ADDSTRING, 0&, ByVal sItemText)
Next
End If

'get the number of items in the target list and return that as the function value

numitems = SendMessageLong(target.hWnd, LB_GETCOUNT, 0&, 0&)
CopyListToList = numitems
End Function

Private Function CopyListToCombo(source As ListBox, target As ComboBox) As Long
Dim c As Long
Const LB_GETCOUNT = &H18B
Const LB_GETTEXT = &H189
Const CB_GETCOUNT = &H146
Const CB_ADDSTRING = &H143

'get the number of items in the list

Dim numitems As Long
Dim sItemText As String * 255

'get the number of items in the source list

numitems = SendMessageLong(source.hWnd, LB_GETCOUNT, 0&, 0&)

'if it has contents, copy the items

If numitems > 0 Then
For c = 0 To numitems - 1
Call SendMessageStr(source.hWnd, LB_GETTEXT, c, ByVal sItemText)
Call SendMessageStr(target.hWnd, CB_ADDSTRING, 0&, ByVal sItemText)
Next
End If

'get the number of items in the target combo and return that as the function value

numitems = SendMessageLong(target.hWnd, CB_GETCOUNT, 0&, 0&)
CopyListToCombo = numitems
End Function