Liên kết Excel với VB6 (1 người xem)

hoang0569 · 16/9/10

Mình mới chập chững VB nên rất mong các bạn giúp, mình gửi File đính kèm theo. Rất cảm ơn

hoang0569 · 18/9/10

Các cao thu GPE đâu rồi giúp tôi với

ndu96081631 · 19/9/10

hoang0569 đã viết:
Mình mới chập chững VB nên rất mong các bạn giúp, mình gửi File đính kèm theo. Rất cảm ơn

Thế sao bạn không dùng Form của Excel mà làm (tức dùng VBA) ---> Làm trên VB6, nội cái chuyện tiếng Việt Unicode cũng là chuyện quá mệt mỏi (nếu không nói là THUA)... còn dùng font TCVN3 thì lại... dở hơi

thkd09 · 17/2/11

Em cũng đang cần cái này lắm. Em đã áp dụng ngon lành, nhưng vẫn có một vấn đề như thế này: Em làm một button chọn đến file Excel và đoạn code chạy ok, nhưng khi chương trình đang chạy em tìm đến 01 file Excel khác thì chương trình báo lỗi "Operation is not allowed when the object is open". Em cũng đã làm thêm một button nữa để khi chọn 01 file khác sẽ đóng kết nối lại nhưng vẫn không được. Mong các bác chỉ giáo. Cảm ơn nhiều.

levanduyet · 17/2/11

thkd09 đã viết:
Em cũng đang cần cái này lắm. Em đã áp dụng ngon lành, nhưng vẫn có một vấn đề như thế này: Em làm một button chọn đến file Excel và đoạn code chạy ok, nhưng khi chương trình đang chạy em tìm đến 01 file Excel khác thì chương trình báo lỗi "Operation is not allowed when the object is open". Em cũng đã làm thêm một button nữa để khi chọn 01 file khác sẽ đóng kết nối lại nhưng vẫn không được. Mong các bác chỉ giáo. Cảm ơn nhiều.

Bạn phải cho xem đoạn code có báo lỗi thì các bạn mới có thể "chỉ giáo" được.

Lê Văn Duyệt

thkd09 · 25/2/11

Các bác test thử giúp em với. Vì em Export file Excel từ một chương trình khác nên tên sheet trùng với tên file.

levanduyet · 25/2/11

Bạn hãy theo link sau: http://www.vbforums.com/showthread.php?t=391665, hướng dẫn rất cụ thể.

Lê Văn Duyệt

thkd09 · 25/2/11

Bác Duyệt ơi, tiếng Anh của em rất kém, bác xem giải quyết cho em được không?

levanduyet · 25/2/11

thkd09 đã viết:
Bác Duyệt ơi, tiếng Anh của em rất kém, bác xem giải quyết cho em được không?

Bạn hãy đưa đoạn mã sau vào một module trong VB:

Mã:

Option Explicit


[COLOR="blue"]'Thủ tục nhập dữ liệu từ Excel[/COLOR]
Sub [B][COLOR="red"]ImportDNFromExcel[/COLOR][/B]()
[COLOR="blue"]'Khai báo và tạo đối tượng Excel[/COLOR]
    Dim oXL As Object
    Dim oXLWb As Object
    Dim oXLWs As Object
    Dim lRow As Long, lLastRow As Long, i As Long, vContent
    Dim sFilePath As String

    On Error GoTo ErrorHandler
        [COLOR="blue"]'Đường dẫn của tập tin muốn lấy dữ liệu[/COLOR]
        sFilePath = "C:\Test.xls" 
        Set oXL = CreateObject("Excel.Application")
       [COLOR="blue"] 'Nếu tập tin tồn tại thì mở[/COLOR]
        Set oXLWb = oXL.Workbooks.Open(sFilePath)
       [COLOR="blue"] 'Lấy dữ liệu từ sheet đầu tiên[/COLOR]
        Set oXLWs = oXLWb.Worksheets(1)
        [COLOR="blue"]'Hàng bắt đầu lấy dữ liệu trong sheet đầu tiên là 6[/COLOR]
        lRow = 6 : lLastRow = 100 
     [COLOR="blue"]   'Bạn có thể dùng 
        'LastRow = oXLWs.Range("A1").End(xlDown).Row
        'LastCol = oXLWs .Range("A1").End(xlToRight).Column
        'để lấy hàng cuối hoặc cột cuối của khối dữ liệu liên tục
        'Nếu bạn muốn người dùng thấy workbook của bạn thì[/COLOR]
       [COLOR="blue"] 'oXL.Visible = True
        'Đến đây bạn có thể bắt đầu lấy dữ liệu từ Excel[/COLOR]
        For i=lRow To lLastRow
           [COLOR="blue"] 'Bắt đầu lấy dữ liệu từ Excel[/COLOR]
            vContent = oXLWs.Range("A" & lRow)
          [COLOR="blue"]  'Đưa dữ liệu lấy được vào các đối tượng hoặc biến bạn muốn lưu trữ dữ liệu
            'Các bước tiếp theo[/COLOR]

        Next i

ErrorExit:
    
   [COLOR="blue"] 'Giải phóng bộ nhớ[/COLOR]
    Set oXLWs = Nothing
 [COLOR="blue"]   'Đóng Workbook lại mà không có lưu[/COLOR]
    oXLWb.Close SaveChanges:=False
    Set oXLWb = Nothing
  [COLOR="blue"]  'Đóng Excel[/COLOR]
    oXL.Quit
    Set oXL = Nothing
    Exit Sub

ErrorHandler:
   [COLOR="blue"] 'Thực hiện gì khi xãy ra lỗi tại đây
    'Ví dụ như thông báo hoặc ghi lỗi ra tập tin chẳng hạn[/COLOR]
    Resume ErrorExit

End Sub

Hy vọng với đoạn mã trên bạn có thể làm được.

Lê Văn Duyệt

Hai Lúa Miền Tây · 26/2/11

Một cách khác nữa là dùng ADO để kết nối và truyền dữ liệu, cách này dể dùng và cải thiện tốc độ đáng kể.

thkd09 · 26/2/11

domfootwear đã viết:
Một cách khác nữa là dùng ADO để kết nối và truyền dữ liệu, cách này dể dùng và cải thiện tốc độ đáng kể.

Bác có thể cho em đoạn code không? Bác đã xem giúp cho em cái em làm chưa? Em mở lần đầu khi chạy thì ok nhưng mở lần 2 thì bị lỗi.

thkd09 · 26/2/11

levanduyet đã viết:
Hy vọng với đoạn mã trên bạn có thể làm được.

Lê Văn Duyệt

Cái này em chạy phát bị đơ luôn bác à! Em nhờ bác sửa giúp em đoạn code bị lỗi trong chương trình giúp em. Em cảm ơn bác!

Hai Lúa Miền Tây · 26/2/11

thkd09 đã viết:
Bác có thể cho em đoạn code không? Bác đã xem giúp cho em cái em làm chưa? Em mở lần đầu khi chạy thì ok nhưng mở lần 2 thì bị lỗi.

Ví dụ file CSDL Excel của bạn có tên là Book1 và nằm chung trong 1 folder thì code sẽ như sau:

Mã:

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Option Explicit

Private Sub Command1_Click()
    Set rs = New ADODB.Recordset
        rs.Open "SELECT * FROM [Sheet1$] ", cn, adOpenDynamic, adLockOptimistic
    Set DataGrid1.DataSource = rs
    
End Sub

Private Sub Form_Load()
On Error GoTo ErrHandler
    Set cn = New ADODB.Connection
    cn.Provider = "Microsoft.Jet.OLEDB.4.0"
    cn.ConnectionString = "Data Source= " & App.Path & "/Book1.xls; Extended Properties=Excel 8.0;"
    cn.CursorLocation = adUseClient
    cn.Open
    
Exit Sub
ErrHandler:
    MsgBox "Khong the ket noi voi CSDL"
End Sub

Private Sub Command3_Click()
Unload Me
End Sub

levanduyet · 26/2/11

thkd09 đã viết:
Bác có thể cho em đoạn code không? Bác đã xem giúp cho em cái em làm chưa? Em mở lần đầu khi chạy thì ok nhưng mở lần 2 thì bị lỗi.

Thật sự ra việc "xin code" thì phải biết cách chỉnh sửa theo nhu cầu của mình. Tại sao lần đầu chạy thì được, lần hai thì bị lỗi? Mà báo lỗi gì thì cũng chẳng nghe bạn nói đến.

Tại sao tôi đưa đoạn code trên (mặc dù có thể dùng ADO thì sẽ nhanh hơn, nhưng thực sự ra nếu bạn muốn đưa vào Workbook của mình thì cũng phải thêm thắt một vài thứ)?
Vì nó sẽ dễ hiểu nếu bạn đã quen với các đối tượng trong VBA cho Excel.

Lê Văn Duyệt

thkd09 · 27/2/11

Em đang làm một chương trình phục vụ cho công việc. CSDL của em là CSDL động, động ở đây là không nhất thiết file csdl phải là một tên file cố định. Vì csdl của em được xuất ra từ một chương trình khác nên có thể người dùng sẽ đặt những tên file khác nhau, họ có thể ghi lại bất cứ nơi nào. Chuơng trình sẽ lấy csld đã được xuất ra vào ADO sau đó lại xuất ra report theo mẫu của công việc. Em sẽ đưa ra trường hợp lỗi của em: Ví dụ ở cơ quan em có 2 người làm chung một máy tính. Người A xuất ra một file A, người B xuất ra một file B, chạy chương trình người A tìm đến file A thì ok, nhưng tìm tiếp đến file B thì bị lỗi. Kính nhờ các bác test thử rồi sửa giúp em.

levanduyet · 27/2/11

thkd09 đã viết:
Em đang làm một chương trình phục vụ cho công việc. CSDL của em là CSDL động, động ở đây là không nhất thiết file csdl phải là một tên file cố định. Vì csdl của em được xuất ra từ một chương trình khác nên có thể người dùng sẽ đặt những tên file khác nhau, họ có thể ghi lại bất cứ nơi nào.

Vậy sao bạn lại có cái tiêu đề: Liên kết Excel với VB6.

Còn đây là một ví dụ lấy nội dung từ file Excel đưa vào file Excel để xử lý:

Mã:

Sub ImportDN()
    Dim xlWb As Workbook
    Dim xlWs As Worksheet
    Dim rngSource As Range, lLastRowSource As Long, lLastRowTarget As Long, lRow As Long
    Dim sFilter As String
    Dim vaFile As Variant
    Dim sPosDate As String
    Dim ExistFolder As Boolean, sPathFolderKeep As String

    On Error GoTo ErrorHandler

    SpeedOn 'Xem trong thư viện code
    'Luu thu muc mac dinh
    sPathFolderKeep = Application.DefaultFilePath
  
    ' Thay đổi thư mục mặc định
    ExistFolder = ChoDirNet("C:\")
    If ExistFolder = False Then
        MsgBox "Loi xay ra khi thay doi thu muc"
        GoTo ErrorHandler
    End If

    'Xây dựng danh sách tập tin muốn hiện ra
    'sFilter = "Excel 2007 Files,*.xlsx," & _
     "Excel 2000-2003 Files,*.xls"
    sFilter = "Excel 2000-2003 Files,*.xls"
    
    vaFile = Application.GetOpenFilename(FileFilter:=sFilter, FilterIndex:=1, _
                                         Title:="Open a New or Old File", MultiSelect:=False)
    'Nếu người dùng Cancel thì thoát, nếu không thì chọn tập tin
    If vaFile <> False Then
        'Đây chỉ là ví dụ tương ứng với dữ liệu của tôi
        'Bạn có thể thay đổi theo như dữ liệu của mình.
        Workbooks.Open Filename:=vaFile
        vaFile = FileNameOnly(vaFile)
        ' Create an instance of Excel and add a workbook
        Set xlWb = Application.Workbooks(vaFile)
        Set xlWs = xlWb.Worksheets(1)
        lLastRowSource = [C6].End(xlDown).Row
        Set rngSource = Range("C6:Q" & lLastRowSource)

        lLastRowTarget = FindLastRow(ThisWorkbook.Worksheets("Delivery_Record"))
        lLastRowTarget = lLastRowTarget + 1
        For lRow = 1 To rngSource.Rows.Count
            With ThisWorkbook.Worksheets("Delivery_Record")
                If Len(rngSource(lRow, 1)) = 0 Then
                    GoTo ErrorExit
                End If
                sPosDate = rngSource(lRow, 10)    'rngSource(lRow, 13)
                ' Delivered date/DN issued date
                .Range("A" & lLastRowTarget) = Format(DateSerial(Mid(sPosDate, 7, 4), Mid(sPosDate, 4, 2), Mid(sPosDate, 1, 2)), "mm/dd/yyyy")
                ' DN No.
                .Range("B" & lLastRowTarget) = rngSource(lRow, 1)
                ' Dealer code
                .Range("C" & lLastRowTarget) = rngSource(lRow, 11)
                ' Dealer name
                .Range("D" & lLastRowTarget).Formula = "=VLOOKUP(C" & lLastRowTarget & ",Dealers,2,0)"
                ' Item code
                .Range("E" & lLastRowTarget) = rngSource(lRow, 4)
                ' Item name
                .Range("F" & lLastRowTarget) = UCase$(Trim$(rngSource(lRow, 5)))
                ' Unit of measurement
                .Range("G" & lLastRowTarget) = rngSource(lRow, 6)
                ' Qty
                .Range("H" & lLastRowTarget) = rngSource(lRow, 7)
                ' This field to check
                .Range("I" & lLastRowTarget) = "DN"    'DN=SAP System, Delivered=Sent to customer
                ' Document no.
                .Range("J" & lLastRowTarget) = rngSource(lRow, 14)
            End With
            'increase lLastRowTarget
            lLastRowTarget = lLastRowTarget + 1
        Next lRow

    Else
        GoTo ErrorExit
    End If

ErrorExit:
    'Close workbook
    Workbooks(vaFile).Close
    'Tra lai thu muc ban dau
    ExistFolder = ChDirNet(sPathFolderKeep)

    SpeedOff
    Exit Sub

ErrorHandler:
    If bCentralErrorHandler(cs_Module_Name, "ImportDN", False) Then
        Stop
        Resume
    Else
        Resume ErrorExit
    End If
End Sub

Chú ý: để việc sử dụng các hằng (ví dụ như: xlDown) trong VBA trong Visual Basic bạn cần phải thêm module sau vào dự án của bạn. Do file tôi đưa lên là file text, vì vậy bạn phải copy nội dung rồi đưa vào một module trong dự án của mình.

Lê Văn Duyệt

Hai Lúa Miền Tây · 28/2/11

thkd09 đã viết:
Em đang làm một chương trình phục vụ cho công việc. CSDL của em là CSDL động, động ở đây là không nhất thiết file csdl phải là một tên file cố định. Vì csdl của em được xuất ra từ một chương trình khác nên có thể người dùng sẽ đặt những tên file khác nhau, họ có thể ghi lại bất cứ nơi nào. Chuơng trình sẽ lấy csld đã được xuất ra vào ADO sau đó lại xuất ra report theo mẫu của công việc. Em sẽ đưa ra trường hợp lỗi của em: Ví dụ ở cơ quan em có 2 người làm chung một máy tính. Người A xuất ra một file A, người B xuất ra một file B, chạy chương trình người A tìm đến file A thì ok, nhưng tìm tiếp đến file B thì bị lỗi. Kính nhờ các bác test thử rồi sửa giúp em.

Bạn chỉnh lại code chút xíu nhé khỏi dùng vòng lặp.

Mã:

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim ExcelFile As String

Private Sub Command1_Click()
    cc.DefaultExt = "XLS"
    cc.Filter = "File Excel(*.xls)|*.xls"
    cc.ShowOpen
    ExcelFile = cc.FileName
    Label2.Caption = UCase(ExcelFile)
    Pos = InStrRev(ExcelFile, "\")
    ExcelFile = Mid(ExcelFile, Pos + 1)
    Pos = InStrRev(ExcelFile, ".")
    ExcelFile = Mid(ExcelFile, 1, Pos - 1)
    Call Import
    cn.Close

End Sub

Private Sub Import()
    cn.Open "Provider= Microsoft.Jet.OLEDB.4.0; data source=" & Label2.Caption & ";" & _
    "Extended Properties=Excel 8.0;"
    rs.CursorLocation = adUseClient
    rs.Open "select * from [" & ExcelFile & "$]", cn, 3, 3
    Set DataGrid1.DataSource = rs
    DataGrid1.Refresh

End Sub

Hai Lúa Miền Tây · 1/3/11

Mã:

Private Sub Import()
    cn.Open "Provider= Microsoft.Jet.OLEDB.4.0; data source=" & Label2.Caption & ";" & _
    "Extended Properties=Excel 8.0;"
    rs.CursorLocation = adUseClient
    rs.Open "select * from [" &[COLOR=red] [B]ExcelFile[/B][/COLOR]& "$]", cn, 3, 3
    Set DataGrid1.DataSource = rs
    DataGrid1.Refresh

End Sub

Code trên cũng chưa linh hoạt lắm, cái này nó lấy tên sheet giống như tên của tên file, nếu như khác thì không thể lấy đúng theo yêu câu được.
Vậy để giải quyết vấn đề trên ta nên dùng 1 combobox để chọn tên sheet, vậy làm sao để lấy tất cả tên sheet đưa vào combobox đó, chỉ dùng ADO.

duy0909939382 · 1/8/11

Truy Vấn Excel trong BV6

Xin giúp.Mình có mốt bài tập như sau :

Tạo ra 1 form gồm có 3 nút CẤP 1 , CẤP 2 ,CÂP 3
CẤP 1 : Liệt kê ra tất cả trong TK với 3 số đầu giống nhau.
CẤP 2 : Liệt kê ra tất cả trong TK với 4 số đầu giống nhau.
CẤP 3 : Liệt kê ra tất cả trong TK với 5 số đầu giống nhau.

Ái biết giúp mình với.Xin cảm ơn
yahoo : dangquocduyit@yahoo.com

online2012 · 10/7/12

chua dung lam. cu hoc nua di moi thay la minh dang dot

Liên kết Excel với VB6 (1 người xem)

Người dùng đang xem chủ đề này

Thành viên thường trực

File đính kèm

Thành viên thường trực

Huyền thoại GPE

Thành viên mới

Hãy để gió cuốn đi.

Thành viên mới

File đính kèm

Hãy để gió cuốn đi.

Thành viên mới

Hãy để gió cuốn đi.

❆❆❆❆❆❆❆❆

Thành viên mới

Thành viên mới

❆❆❆❆❆❆❆❆

File đính kèm

Hãy để gió cuốn đi.

Thành viên mới

File đính kèm

Hãy để gió cuốn đi.

File đính kèm

❆❆❆❆❆❆❆❆

File đính kèm

❆❆❆❆❆❆❆❆

Thành viên mới

File đính kèm

Thành viên mới

Đếm ngược thời gian