Tạo danh sách cho combo trong VB6 lấy danh sách từ excel

[maytinhvp01]

Giả sử mình có file excel book1, tại sheet1 có danh sách từ "A1:A6"
Mình muốn đưa danh sách này vào danh sách của combo trong form của VB6 thì làm như thế nào vây??

 

[ndu96081631]

Giả sử mình có file excel book1, tại sheet1 có danh sách từ "A1:A6"
Mình muốn đưa danh sách này vào danh sách của combo trong form của VB6 thì làm như thế nào vây??

Dùng ADO là khỏe nhất
1> Cho code dưới đây vào module:

Function GetData(ByVal FileName As String, ByVal SheetName As String, ByVal RangeAddress As String)
            
  Dim rsCon As Object, rsData As Object, cat As Object, tbl As Object, ExlApp As Object
  Dim szConnect As String, szSQL As String, tmp As String
  Dim lCount As Long, lR As Long, lC As Long, lVer As Long
  Set ExlApp = CreateObject("Excel.Application")
  lVer = Val(ExlApp.Version)
  Set rsCon = CreateObject("ADODB.Connection")
  Set rsData = CreateObject("ADODB.Recordset")
  Set cat = CreateObject("ADOX.Catalog")
  
  If lVer < 12 Then
    szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName & _
                ";Extended Properties=""Excel 8.0;HDR=No"";"
  Else
    szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & _
                ";Extended Properties=""Excel 12.0;HDR=No"";"
  End If
  If SheetName = "" Then
    Dim Dbs  As Object, db As Object
    Set Dbs = CreateObject("DAO.DBEngine." & IIf(lVer < 12, "36", "120"))
    Set db = Dbs.OpenDatabase(FileName, False, False, "Excel 8.0;")
    tmp = db.TableDefs(0).Name
    tmp = Replace(tmp, " ", "?")
    tmp = Replace(tmp, "'", " ")
    tmp = ExlApp.WorksheetFunction.Trim(tmp)
    tmp = Replace(tmp, " ", "'")
    tmp = Replace(tmp, "?", " ")
    SheetName = tmp
    db.Close
    Set Dbs = Nothing: Set db = Nothing
  End If
  If Right(SheetName, 1) <> "$" Then SheetName = SheetName & "$"
  rsCon.Open szConnect
  cat.ActiveConnection = rsCon
  szSQL = "SELECT * FROM [" & SheetName & RangeAddress & "];"
  rsData.Open szSQL, rsCon, 0, 1, 1
  GetData = rsData.GetRows
  rsData.Close: Set rsData = Nothing
  rsCon.Close: Set rsCon = Nothing
  Set ExlApp = Nothing
End Function

2> Code trong Form

Private Sub Form_Load()
  Dim arr, Item
  Dim FileName As String, SheetName As String, RangeAddress As String
  FileName = App.Path & "\Book1.xlsx"
  SheetName = "Sheet1"
  RangeAddress = "A1:A5"
  arr = GetData(FileName, SheetName, RangeAddress)
  If IsArray(arr) Then
    For Each Item In arr
      Me.Combo1.AddItem CStr(Item)
    Next
    Me.Combo1.ListIndex = 0
  End If
End Sub

Xong!

 

[maytinhvp01]

Cảm ơn anh Ndu em dùng code và tìm hiểu có gì em không hiểu em sẽ hỏi anh tiếp ạ