Bị lỗi Subscript out of range- err #91 (2 người xem)

luanon · 7/11/12

Hi all,
Mình dùng Access, xuất data ra file excel, nhưng hễ cứ tới phần chữ màu đỏ bên dưới là xuất hiện lỗi Out of range. Nhờ anh chị có kinh nghiệm chỉ giáo giúp nhé, Cảm ơn

Hàm Nút outfile như sau:

Private Sub cmd_Outfile_userSheet_Click()
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("qry_DMS_UserQualifiedList_0")
'FileCopy txt_templatePath, txt_outputpath
Call WriteRecordset("A2", "User", rs, txt_templatePath, 2, "", False)
Set rs = Nothing
End Sub

Public Sub WriteRecordset(Vposition As String, shetname As String, vrc As DAO.Recordset, path As String, ShowHiddenVeryHidden As Double, pwd As String, ClosefileAfterDone As Boolean)

Dim wb As String: Dim pos As Byte
Dim objWbook As Excel.Application
pos = InStrRev(path, "\")
wb = Mid(path, pos + 1)
vrc.MoveFirst
Excel.Application.DisplayAlerts = False
Excel.Application.Visible = True
If IsWorkbookOpen(path) = False Then
Excel.Workbooks.Open path
ElseIf IsWorkbookOpen(path) = True Then
Workbooks(wb).Activate
End If

Excel.Sheets("" & shetname & "").Visible = True
Excel.Sheets("" & shetname & "").Select
If CheckIfSheetProtected(Excel.Sheets("" & shetname & "")) Then Call unProtectSheet(shetname, pwd)
Excel.Range("" & Vposition & "").CopyFromRecordset vrc
Excel.Sheets("" & shetname & "").Visible = ShowHiddenVeryHidden
Excel.ActiveWorkbook.Save
If ClosefileAfterDone = True Then Excel.ActiveWorkbook.Close
Excel.Application.DisplayAlerts = True
End Sub

Function IsWorkbookOpen(fname As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next
filenum = FreeFile()
Open fname For Input Lock Read As #filenum
Close filenum
errnum = Err
On Error GoTo 0
Select Case errnum
Case 0
IsWorkbookOpen = False
Case 70
IsWorkbookOpen = True
End Select
End Function

Hoàng Trọng Nghĩa · 7/11/12

Nhìn một phần của thủ tục này:

Public Sub WriteRecordset(Vposition As String, shetname As String, vrc As DAO.Recordset, path As String, ShowHiddenVeryHidden As Double, pwd As String, ClosefileAfterDone As Boolean)

Dim wb As String: Dim pos As Byte
Dim objWbook As Excel.Application
pos = InStrRev(path, "\")
wb = Mid(path, pos + 1)

Bạn xem lại có chắc wb = Tên file đó chưa? Bạn thử lấy đường dẫn và chạy với pos và wb xem, nếu đúng tên file thì ta tính tiếp, không thì thôi.

luanon · 7/11/12

Mình xin nói thêm cho rõ chút:
Nếu mình không dùng hàm check isWorkbookOpen, mà mở thẳng file excel thì sẽ không bị vấn đề này. Trước khi export thì phải close file lại.

Mình thấy bất tiện nên code thêm, và mới bị lỗi như vậy. Thậtra mình muốn, file đang mở, chỉ cần bấm nút là nó xuất ra file đang mở luôn, không cần fải đóng file lại.

luanon · 7/11/12

pos và wb là chuẩn rồi bạn. Ví dụ path= "C:\Report\Test.xlsm" thì tên workbook wb= "Test.xlsm"

ptm0412 · 7/11/12

Thử thế này xem:
Excel.Workbooks(wb).Activate

Hoàng Trọng Nghĩa · 7/11/12

luanon đã viết:
pos và wb là chuẩn rồi bạn. Ví dụ path= "C:\Report\Test.xlsm" thì tên workbook wb= "Test.xlsm"

Tôi thử test và hoàn toàn không phát hiện lỗi do phần check:

PHP:

Sub test()
      Dim PathName As String, pos As Long, wb As String
      
      PathName = "C:\Users\trongnghia\Desktop\GUIANHNGHIA.xls"
      pos = InStrRev(PathName, "\")
      wb = Mid(PathName, pos + 1)

      If IsWorkbookOpen(PathName) Then
            Workbooks(wb).Activate
      Else
            Excel.Workbooks.Open PathName
      End If
End Sub

luanon · 7/11/12

Rất cảm ơn các bạn dành thời gian trả lời giúp.
@Nghĩa: error không phải xuất hiện ở phần check mà là nếu file đã open rồi thì mình không lấy được Excel instance nên phát sinh lỗi out of range.
@all : mình phát hiệnra là do VBA không hiểu được Excel instance đã mở trước đó.
Cách khắc phục: mình chỉ mới nghĩ ra thôi, chưa check, mai mình sẽ gửi code lên cho các bạn :
Nếufile đã được mở, thì phảidùng hàm create object excel. tạo một instance cho nó, rồi gán workbook là tên workbooks đã mở, thì code sẽ chạybình thường

Hoàng Trọng Nghĩa · 7/11/12

Tôi thấy rồi, lỗi nằm tại đây: Excel.Sheets("" & shetname & "")

Bỏ phần đỏ, giữ lại phần xanh là không bị nữa!

Mã:

Sub test()
      Dim PathName As String, pos As Long, wb As String
      Dim SheetName As String
      PathName = "C:\Users\trongnghia\Desktop\GUIANHNGHIA.xls"
      pos = InStrRev(PathName, "\")
      wb = Mid(PathName, pos + 1)
      
      If IsWorkbookOpen(PathName) Then
            Excel.Workbooks(wb).Activate
      Else
            Excel.Workbooks.Open PathName
      End If
      [COLOR=#ff0000][B]SheetName = "Sheet1"[/B][/COLOR]
      [COLOR=#0000cd][B]Workbooks(wb).Sheets([/B][/COLOR][COLOR=#ff0000][B]SheetName[/B][/COLOR][COLOR=#0000cd][B]).Select[/B][/COLOR]
End Sub

Hoàng Trọng Nghĩa · 7/11/12

Tôi thử sửa lại code cho bạn, không biết bạn ứng dụng còn lỗi nữa không:

Mã:

Sub WriteRecordset(Vposition As String, SheetName As String, vrc As DAO.Recordset, PathName As String, ShowHiddenVeryHidden As Double, pwd As String, ClosefileAfterDone As Boolean)
      Dim wb As String, pos As Byte
      Dim objWbook As Excel.Application[COLOR=#008000] '<<Cai nay de lam gi ta?[/COLOR]
      pos = InStrRev(PathName, "\")
      wb = Mid(PathName, pos + 1)

      With Excel.Application
            .DisplayAlerts = False
            .Visible = True
            If IsWorkbookOpen(PathName) Then
                  .Workbooks(wb).Activate
            Else
                  .Workbooks.Open PathName
            End If

            vrc.MoveFirst

            With Workbooks(wb).Sheets(SheetName)
                  .Visible = True
                        .Select
                              If CheckIfSheetProtected(SheetName) Then Call unProtectSheet(SheetName, pwd)
                        .Range(Vposition).CopyFromRecordset vrc
                  .Visible = ShowHiddenVeryHidden
            End With

            .ActiveWorkbook.Save
            If ClosefileAfterDone Then .ActiveWorkbook.Close
            .DisplayAlerts = True
      End With
End Sub

luanon · 8/11/12

mình vẫ chưa tìm ra cách khắc phục. Code của bạn Nghĩa vẫn bị lỗi ở dòng .Workbooks(wb).Activate ---> out of range

Hoàng Trọng Nghĩa · 8/11/12

luanon đã viết:
mình vẫ chưa tìm ra cách khắc phục. Code của bạn Nghĩa vẫn bị lỗi ở dòng .Workbooks(wb).Activate ---> out of range

Đoán tới đoán lui cũng chỉ là đoán mò, vậy bạn gửi 2 cái file kết nối với nhau như thế nào lên đây đi sẽ dễ dàng làm việc hơn! Biết đâu tôi hoặc mọi người sẽ tối ưu code cho bạn.

luanon · 8/11/12

Thank bạn Nghĩa,thực ra mình dốt code lắm, nên fix lỗi hơi lâu tí, mình đoán đượcbệnh mà do ko học chuuyên về code nên đành google vậy.
Bệnh của em nó là:
- Từ Access, open excel--> export data ra file excel đã open ---> bình thường không có vấn đềgì
- Vấn đề bắt đầu xuất hiện là : nếu file excel mà ta muốn export ra đã được open trước đó, nếu không muốn Close file excel đó trước khi export recordset từ Acess thì phải viết 1 hàm bắt được instance của Excel, sau đó mới activate workbook trong đống workbooks mà application Excel đó đang chứa.
Từ đó, làm bình thường.
Code mình tìm thấyvà chạy ổn như sau:
1. Vẫn sử dụng hàm mà Nghĩa đã viết lại, thậtra như nhau, nhưng đúng là Nghĩa viết lạigọnđẹp. Ngay phía trước dòng màu đỏ (.Workbooks(wb).Activate) ta phải dùng hàm API tìm kiếm và activate Excel nữalà xong.

Sub WriteRecordset(Vposition As String, SheetName As String, vrc As DAO.Recordset, PathName As String, ShowHiddenVeryHidden As Double, pwd As String, ClosefileAfterDone As Boolean)
Dim wb As String, pos As Byte
pos = InStrRev(PathName, "\")
wb = Mid(PathName, pos + 1)

With Excel.Application
.DisplayAlerts = False
.Visible = True
If IsWorkbookOpen(PathName) Then
ActivateExcel <--- them vao cho nay
.Workbooks(wb).Activate

Else
.Workbooks.Open PathName
End If

vrc.MoveFirst

With Workbooks(wb).Sheets(SheetName)
.Visible = True
.Select
If CheckIfSheetProtected(SheetName) Then Call unProtectSheet(SheetName, pwd)
.Range(Vposition).CopyFromRecordset vrc
.Visible = ShowHiddenVeryHidden
End With

.ActiveWorkbook.Save
If ClosefileAfterDone Then .ActiveWorkbook.Close
.DisplayAlerts = True
End With
End Sub

2. Đây là hàm Windows API cần dùng. Mình tôn trọng, copy nguyên bản nhé :

Option Explicit
Option Compare Text

' modActivateExcel
' By Chip Pearson, www.cpearson.com, chip@cpearson.com

' Window API Declarations
' These Declares MUST appear at the top of the
' code module, above and before any VBA procedures.

Private Declare Function BringWindowToTop Lib "user32" ( _
ByVal HWnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function SetFocus Lib "user32" ( _
ByVal HWnd As Long) As Long
Public Sub ActivateExcel()

' ActivateExcel
' This procedure activates the main Excel application window,
' ("XLMAIN") moving it to the top of the Z-Order and sets keyboard
' focus to Excel.
'
' !!!!!!!!!!!!!!!!!!!!!!!!!
' NOTE: This will not work properly if a VBA Editor is open.
' If a VBA Editor window is open, the system will set focus
' to that window, rather than the XLMAIN window.
' !!!!!!!!!!!!!!!!!!!!!!!!!
'
' This code should work to activate any application. Change the
' value of C_MAIN_WINDOW_CLASS to the application's main window
' class (e.g., "OpusApp" for Word).

Dim Res As Long ' General purpose Result variable
Dim XLHWnd As Long ' Window handle of Excel
Const C_MAIN_WINDOW_CLASS = "XLMAIN"

' Get the window handle of the main
' Excel application window ("XLMAIN"). If
' more than one instance of Excel is running,
' you have no control over which
' instance's HWnd will be retrieved.
' Related Note: You MUST use vbNullString
' not an empty string "" in the call to
' FindWindow. When calling API functions
' there is a difference between vbNullString
' and an empty string "".

XLHWnd = FindWindow(lpClassName:=C_MAIN_WINDOW_CLASS, _
lpWindowName:=vbNullString)

If XLHWnd > 0 Then

' If HWnd is > 0, FindWindow successfully
' found the Excel main application window.
' Move XLMAIN to the top of the
' Z-Order.

Res = BringWindowToTop(HWnd:=XLHWnd)

If Res = 0 Then
Debug.Print "Error With BringWindowToTop: " & _
CStr(Err.LastDllError)
Else

' No error.
' Set keyboard input focus XLMAIN

SetFocus HWnd:=XLHWnd
End If
Else

' HWnd was 0. FindWindow couldn't
' find Excel.

Debug.Print "Can't find Excel"
End If
End Sub

siwtom · 8/11/12

luanon đã viết:
Thank bạn Nghĩa,thực ra mình dốt code lắm, nên fix lỗi hơi lâu tí, mình đoán đượcbệnh mà do ko học chuuyên về code nên đành google vậy.
Bệnh của em nó là:
- Từ Access, open excel--> export data ra file excel đã open ---> bình thường không có vấn đềgì
- Vấn đề bắt đầu xuất hiện là : nếu file excel mà ta muốn export ra đã được open trước đó, nếu không muốn Close file excel đó trước khi export recordset từ Acess thì phải viết 1 hàm bắt được instance của Excel, sau đó mới activate workbook trong đống workbooks mà application Excel đó đang chứa.
Từ đó, làm bình thường.
Code mình tìm thấyvà chạy ổn như sau:
1. Vẫn sử dụng hàm mà Nghĩa đã viết lại, thậtra như nhau, nhưng đúng là Nghĩa viết lạigọnđẹp. Ngay phía trước dòng màu đỏ (.Workbooks(wb).Activate) ta phải dùng hàm API tìm kiếm và activate Excel nữalà xong.

Sub WriteRecordset(Vposition As String, SheetName As String, vrc As DAO.Recordset, PathName As String, ShowHiddenVeryHidden As Double, pwd As String, ClosefileAfterDone As Boolean)
Dim wb As String, pos As Byte
pos = InStrRev(PathName, "\")
wb = Mid(PathName, pos + 1)

With Excel.Application
.DisplayAlerts = False
.Visible = True
If IsWorkbookOpen(PathName) Then
ActivateExcel <--- them vao cho nay
.Workbooks(wb).Activate

Else
.Workbooks.Open PathName
End If

vrc.MoveFirst

With Workbooks(wb).Sheets(SheetName)
.Visible = True
.Select
If CheckIfSheetProtected(SheetName) Then Call unProtectSheet(SheetName, pwd)
.Range(Vposition).CopyFromRecordset vrc
.Visible = ShowHiddenVeryHidden
End With

.ActiveWorkbook.Save
If ClosefileAfterDone Then .ActiveWorkbook.Close
.DisplayAlerts = True
End With
End Sub

2. Đây là hàm Windows API cần dùng. Mình tôn trọng, copy nguyên bản nhé :

Option Explicit
Option Compare Text

' modActivateExcel
' By Chip Pearson, www.cpearson.com, chip@cpearson.com

' Window API Declarations
' These Declares MUST appear at the top of the
' code module, above and before any VBA procedures.

Private Declare Function BringWindowToTop Lib "user32" ( _
ByVal HWnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function SetFocus Lib "user32" ( _
ByVal HWnd As Long) As Long
Public Sub ActivateExcel()

' ActivateExcel
' This procedure activates the main Excel application window,
' ("XLMAIN") moving it to the top of the Z-Order and sets keyboard
' focus to Excel.
'
' !!!!!!!!!!!!!!!!!!!!!!!!!
' NOTE: This will not work properly if a VBA Editor is open.
' If a VBA Editor window is open, the system will set focus
' to that window, rather than the XLMAIN window.
' !!!!!!!!!!!!!!!!!!!!!!!!!
'
' This code should work to activate any application. Change the
' value of C_MAIN_WINDOW_CLASS to the application's main window
' class (e.g., "OpusApp" for Word).

Dim Res As Long ' General purpose Result variable
Dim XLHWnd As Long ' Window handle of Excel
Const C_MAIN_WINDOW_CLASS = "XLMAIN"

' Get the window handle of the main
' Excel application window ("XLMAIN"). If
' more than one instance of Excel is running,
' you have no control over which
' instance's HWnd will be retrieved.
' Related Note: You MUST use vbNullString
' not an empty string "" in the call to
' FindWindow. When calling API functions
' there is a difference between vbNullString
' and an empty string "".

XLHWnd = FindWindow(lpClassName:=C_MAIN_WINDOW_CLASS, _
lpWindowName:=vbNullString)

If XLHWnd > 0 Then

' If HWnd is > 0, FindWindow successfully
' found the Excel main application window.
' Move XLMAIN to the top of the
' Z-Order.

Res = BringWindowToTop(HWnd:=XLHWnd)

If Res = 0 Then
Debug.Print "Error With BringWindowToTop: " & _
CStr(Err.LastDllError)
Else

' No error.
' Set keyboard input focus XLMAIN

SetFocus HWnd:=XLHWnd
End If
Else

' HWnd was 0. FindWindow couldn't
' find Excel.

Debug.Print "Can't find Excel"
End If
End Sub

Trời ơi, sao bạn lại dùng FindWindow? Excel là server COM nên bạn dùng CreateObject hoặc GetObject thôi.
Để có thể thao tác với Excel thì bạn phải có đối tượng Application.
1. Nếu bạn muốn kích hoạt server Excel thì dùng CreateObject --> bạn có Application
2. Nếu server đã "hoạt động" rồi và bạn muốn "dùng" nó thì thay vì CreateObject bạn dùng GetObject
-----------
GetObject --> nếu server đã được kích hoạt trước đó thì trả về Application, nếu chưa được kích hoạt thì có lỗi.
CreateObject --> luôn kích hoạt server.
Vậy bạn có thể thao tác như sau:

Mã:

Dim ExcelApp As Object
...
Err.Clear
'    tìm server Excel đang hoạt động
    Set ExcelApp = GetObject(, "Excel.Application")
    If Err Then
'       Excel chưa hoạt động
        Err.Clear
'        khởi động server Excel
        Set ExcelApp = CreateObject("Excel.Application")
        If Err Then
            Err.Clear
            Exit Sub
        End If
    End If
.....
Tới chỗ này thì bạn đã có đối tượng ExcelApp (là server đã hoạt động và bạn muốn truy cập tới, hoặc là server mà bạn kích hoạt khi dùng CreateObject
...
With ExcelApp.Workbooks hic hic he he
...

luanon · 8/11/12

minh cũng đã sử dụng GetObject ròi, nhưng vẫn bị lỗi!! nên mới ko biết nó bị lỗi gì !!! chắc tại mình viết sai chỗ nào đó! để mình check lại rồi báo lại ban! thank nhe !!

siwtom · 8/11/12

luanon đã viết:
minh cũng đã sử dụng GetObject ròi, nhưng vẫn bị lỗi!! nên mới ko biết nó bị lỗi gì !!! chắc tại mình viết sai chỗ nào đó! để mình check lại rồi báo lại ban! thank nhe !!

Bạn nói thế nào ấy.
Bạn viết:: "Ngay phía trước dòng màu đỏ (.Workbooks(wb).Activate) ta phải dùng hàm API tìm kiếm và activate Excel nữa là xong"
Nếu bạn có đối tượng trả về bởi GetObject thì dùng nó để thao tác thôi. Tôi không hiểu tại sao lại phải dùng hàm API để tìm kiếm cái gì nữa.
Tôi hiểu cái "Excel" của bạn là đối tượng trả về bởi GetObject. Ta dùng ExcelApp nhé:
Set ExcelApp = GetObject(...)
Rồi sau đó thì cứ:
ExcelApp.DisplayAlerts = False
ExcelApp.Visible = True
ExcelApp.Workbooks(wb) gì gì đó
v...v
Thế thôi.
Mà đã có đối tượng Application (ExcelApp) thì dùng nó để kiểm tra xem workbook có đang được mở không chứ sao lại phải dùng cái IsWorkbookOpen là thế nào?
Bạn đã có đối tượng Application do GetObject hay CreateObject trả về thì dùng nó thôi chứ sao lại IsWorkbookOpen với lại FindWindow để làm cái gì?

Mã:

Dim ExcelApp As Object
...
Err.Clear
'    tìm server Excel đang hoạt động
    Set ExcelApp = GetObject(, "Excel.Application")
    If Err Then
'       Excel chưa hoạt động
        Err.Clear
'        khởi động server Excel
        Set ExcelApp = CreateObject("Excel.Application")
        If Err Then
            Err.Clear
            Exit Sub
        End If
    End If
...

Set book = ExcelApp.Workbooks(wb)
If book Is Nothing Then
' workbook chưa được mở
' mở workbook
 Set book = ExcelApp.Workbooks.Open Filename:= ...
End If
book.Activate

--------------
Mà bạn đưa toàn bộ code lên cho nhanh

Bị lỗi Subscript out of range- err #91 (2 người xem)

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

luanon

Thành viên mới

Hoàng Trọng Nghĩa

Chuyên gia GPE

luanon

Thành viên mới

luanon

Thành viên mới

ptm0412

Bad Excel Member

Hoàng Trọng Nghĩa

Chuyên gia GPE

luanon

Thành viên mới

Hoàng Trọng Nghĩa

Chuyên gia GPE

Hoàng Trọng Nghĩa

Chuyên gia GPE

luanon

Thành viên mới

Hoàng Trọng Nghĩa

Chuyên gia GPE

luanon

Thành viên mới

siwtom

Thành viên gắn bó

luanon

Thành viên mới

siwtom

Thành viên gắn bó

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian