Run-time error '9' subscript out of range (1 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
duongvanminh33

duongvanminh33

Thành viên mới
Tham gia
16/3/19
Bài viết
31
Được thích
3
Sub Button7_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim printFrom As Variant, printTo As Variant
Dim sFile As String
Dim sPath As String
Dim i As Long
printFrom = Sheets("Sheet3").Range("I8")
printTo = Sheets("Sheet3").Range("I9")
Set OutApp = CreateObject("Outlook.Application")
For i = printFrom To printTo
Sheets("Sheet3").Range("I5") = i
ThisWorkbook.Sheets("Sheet3").Range("A1:D33").Select
Range("A1:D33").Copy
Workbooks.Add(xlWBATWorksheet).Sheets("Sheet1").Select
Range("A1:D33").Select
ActiveWorkbook.ActiveSheet.PasteSpecial
Columns("A:D").AutoFit
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value 'HAM NAY CHI DC DUNG TRONG RANGE
sFile = ActiveWorkbook.Path & "\" & "Payslip Oct 2020 - " & Sheets("Sheet3").Range("B11") & ".xlsx"
ActiveWorkbook.SaveAs Filename:=sFile, FileFormat:=51, WriteResPassword:="", ReadOnlyRecommended:=True _
, CreateBackup:=False
Workbooks.Add.Close Savechanges:=False
ActiveWorkbook.Close False

Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Sheets("Sheet3").Range("B12")
.cc = ""
.BCC = ""
.Subject = Sheets("Sheet3").Range("B9")
.HTMLBody = " Dear " & Sheets("Sheet3").Range("B11") & "</B> <BR><BR> Kindly find attachment payslip of October 2020. <BR>" & _
"<BR>Should you have any questions, do not hestitate to contact us." & _
"<BR><BR>Thanks & regards</B><BR>" & _
"</B>"
.Attachments.Add (sFile)
.Send
End With
Set OutMail = Nothing
Next i
Set OutApp = Nothing
Set OutMail = Nothing
MsgBox "Success"

End Sub



Mình lại dính lỗi nãy, mình có xem xét lại từ đầu đến cuối mà vẫn báo lỗi sFile = ActiveWorkbook.Path & "\" & "Payslip Oct 2020 - " & Sheets("Sheet3").Range("B11") & ".xlsx"
Mấy anh giúp em với ạ, em không hiểu sai chổ nào cả.
 
Không có Sheet3
 
ptm0412 đã viết:
Hình như đã có, vì bên trên các câu lệnh bên trên liên quan đến nó chưa lỗi: printFrom, printTo, Select
Nhấp chuột vào đây để mở rộng...
Lúc nãy em không xem các dòng code khác, giờ xem kỹ lại thì lỗi vẫn là do file hiện hành không có Sheet3.
File chứa code thì có Sheet3 nhưng file mới tạo bằng lệnh Workbooks.Add thì không có. Code trỏ đến Sheet3 (bằng SheetName) mà không xác định workbook nên mặc định trỏ đến workbook hiện hành. Khi thêm workbook mới thì workbook mới thành workbook hiện hành, code trỏ đến Sheet3 của workbook hiện hành nhưng không có -> lỗi.
Nếu muốn trỏ đến Sheet3 của workbook chứa code thì viết rõ ThisWorkbook.Sheets("Sheet3"). Ngoài ra, ActiveWorkbook.Path trong dòng lệnh đó luôn trả về.chuỗi rỗng do ActiveWorkbook là workbook chưa được save.
@Chủ topic: Nên tạo thói quen khi trỏ đến đối tượng bằng tên thì chỉ rõ đối tượng cha. Thói quen này giúp code rõ ràng hơn và hạn chế lỗi hoặc code thực thi không đúng ý đồ của người viết code. Lỗi còn biết để mà sửa chứ chạy sai mà không phát hiện được thì hậu quả khôn lường.
 
huuthang_bd đã viết:
Lúc nãy em không xem các dòng code khác, giờ xem kỹ lại thì lỗi vẫn là do file hiện hành không có Sheet3.
File chứa code thì có Sheet3 nhưng file mới tạo bằng lệnh Workbooks.Add thì không có. Code trỏ đến Sheet3 (bằng SheetName) mà không xác định workbook nên mặc định trỏ đến workbook hiện hành. Khi thêm workbook mới thì workbook mới thành workbook hiện hành, code trỏ đến Sheet3 của workbook hiện hành nhưng không có -> lỗi.
Nhấp chuột vào đây để mở rộng...
Như vậy phải sửa ActiveWokbook thành ThisWorkbook ở câu này:
sFile = ActiveWorkbook.Path & "\" & "Payslip Oct 2020 - " & Sheets("Sheet3").Range("B11") & ".xlsx"

Ngoài ra câu này cũng sẽ lỗi vì vừa Add vừa Close (2 phương thức)
Workbooks.Add.Close Savechanges:=False

Và câu này cũng có nguy cơ lỗi vì không biết workbook nào
ActiveWorkbook.Close False
 
duongvanminh33 đã viết:
Sub Button7_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim printFrom As Variant, printTo As Variant
Dim sFile As String
Dim sPath As String
Dim i As Long
printFrom = Sheets("Sheet3").Range("I8")
printTo = Sheets("Sheet3").Range("I9")
Set OutApp = CreateObject("Outlook.Application")
For i = printFrom To printTo
Sheets("Sheet3").Range("I5") = i
ThisWorkbook.Sheets("Sheet3").Range("A1:D33").Select
Range("A1:D33").Copy
Workbooks.Add(xlWBATWorksheet).Sheets("Sheet1").Select
Range("A1:D33").Select
ActiveWorkbook.ActiveSheet.PasteSpecial
Columns("A:D").AutoFit
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value 'HAM NAY CHI DC DUNG TRONG RANGE
sFile = ActiveWorkbook.Path & "\" & "Payslip Oct 2020 - " & Sheets("Sheet3").Range("B11") & ".xlsx"
ActiveWorkbook.SaveAs Filename:=sFile, FileFormat:=51, WriteResPassword:="", ReadOnlyRecommended:=True _
, CreateBackup:=False
Workbooks.Add.Close Savechanges:=False
ActiveWorkbook.Close False

Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Sheets("Sheet3").Range("B12")
.cc = ""
.BCC = ""
.Subject = Sheets("Sheet3").Range("B9")
.HTMLBody = " Dear " & Sheets("Sheet3").Range("B11") & "</B> <BR><BR> Kindly find attachment payslip of October 2020. <BR>" & _
"<BR>Should you have any questions, do not hestitate to contact us." & _
"<BR><BR>Thanks & regards</B><BR>" & _
"</B>"
.Attachments.Add (sFile)
.Send
End With
Set OutMail = Nothing
Next i
Set OutApp = Nothing
Set OutMail = Nothing
MsgBox "Success"

End Sub



Mình lại dính lỗi nãy, mình có xem xét lại từ đầu đến cuối mà vẫn báo lỗi sFile = ActiveWorkbook.Path & "\" & "Payslip Oct 2020 - " & Sheets("Sheet3").Range("B11") & ".xlsx"
Mấy anh giúp em với ạ, em không hiểu sai chổ nào cả.
Nhấp chuột vào đây để mở rộng...
Mình nghĩ rằng để không bị lẫn lộn giữa cái workbook hiện tại với workbook tạo mới thì bạn nên tạo ra 2 biến:
Mã: 
Dim wbNew As Workbook, wbThis As Workbook
Với cái này thì mình viết lại cái code (viết theo mình suy nghĩ là vậy, có thể code không đúng ý đồ của bạn chỗ nào thì bạn chỉnh lại chỗ đó giúp nha...)

Mã: 
Sub Button7_Click()
Dim OutApp As Object, OutMail As Object
Dim printFrom As Variant, printTo As Variant
Dim sFile As String, sPath As String
Dim i As Long
Dim wbNew As Workbook, wbThis As Workbook
    Set wbThis = ThisWorkbook
    printFrom = wbThis.Sheets("Sheet3").Range("I8")
    printTo = wbThis.Sheets("Sheet3").Range("I9")
    Set OutApp = CreateObject("Outlook.Application")
    For i = printFrom To printTo
        wbThis.Sheets("Sheet3").Range("I5") = i
        Set wbNew = Workbooks.Add(xlWBATWorksheet)
       
        wbThis.Sheets("Sheet3").Range("A1:D33").Copy
        With wbNew.Sheets("Sheet1")
            .Range("A1:D33").PasteSpecial xlPasteValues
            .Range("A1:D33").PasteSpecial xlPasteFormats
            .Columns("A:D").AutoFit
        End With
        Application.CutCopyMode = False
       
        sFile = wbThis.Path & "\" & "Payslip Oct 2020 - " & wbThis.Sheets("Sheet3").Range("B11") & ".xlsx"
        wbNew.SaveAs Filename:=sFile, FileFormat:=51, WriteResPassword:="", ReadOnlyRecommended:=True, CreateBackup:=False
        wbNew.Close False
        Set wbNew = Nothing
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = wbThis.Sheets("Sheet3").Range("B12")
            .cc = ""
            .BCC = ""
            .Subject = wbThis.Sheets("Sheet3").Range("B9")
            .HTMLBody = " Dear " & Sheets("Sheet3").Range("B11") & "</B> <BR><BR> Kindly find attachment payslip of October 2020. <BR>" & _
            "<BR>Should you have any questions, do not hestitate to contact us." & _
            "<BR><BR>Thanks & regards</B><BR>" & _
            "</B>"
            .Attachments.Add (sFile)
            .Send
        End With
        Set OutMail = Nothing
    Next i
    Set OutApp = Nothing
    Set OutMail = Nothing
    MsgBox "Success"

End Sub
 
duongvanminh33 đã viết:
Sub Button7_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim printFrom As Variant, printTo As Variant
Dim sFile As String
Dim sPath As String
Dim i As Long
printFrom = Sheets("Sheet3").Range("I8")
printTo = Sheets("Sheet3").Range("I9")
Set OutApp = CreateObject("Outlook.Application")
For i = printFrom To printTo
Sheets("Sheet3").Range("I5") = i
ThisWorkbook.Sheets("Sheet3").Range("A1:D33").Select
Range("A1:D33").Copy
Workbooks.Add(xlWBATWorksheet).Sheets("Sheet1").Select
Range("A1:D33").Select
ActiveWorkbook.ActiveSheet.PasteSpecial
Columns("A:D").AutoFit
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value 'HAM NAY CHI DC DUNG TRONG RANGE
sFile = ActiveWorkbook.Path & "\" & "Payslip Oct 2020 - " & Sheets("Sheet3").Range("B11") & ".xlsx"
ActiveWorkbook.SaveAs Filename:=sFile, FileFormat:=51, WriteResPassword:="", ReadOnlyRecommended:=True _
, CreateBackup:=False
Workbooks.Add.Close Savechanges:=False
ActiveWorkbook.Close False

Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Sheets("Sheet3").Range("B12")
.cc = ""
.BCC = ""
.Subject = Sheets("Sheet3").Range("B9")
.HTMLBody = " Dear " & Sheets("Sheet3").Range("B11") & "</B> <BR><BR> Kindly find attachment payslip of October 2020. <BR>" & _
"<BR>Should you have any questions, do not hestitate to contact us." & _
"<BR><BR>Thanks & regards</B><BR>" & _
"</B>"
.Attachments.Add (sFile)
.Send
End With
Set OutMail = Nothing
Next i
Set OutApp = Nothing
Set OutMail = Nothing
MsgBox "Success"

End Sub



Mình lại dính lỗi nãy, mình có xem xét lại từ đầu đến cuối mà vẫn báo lỗi sFile = ActiveWorkbook.Path & "\" & "Payslip Oct 2020 - " & Sheets("Sheet3").Range("B11") & ".xlsx"
Mấy anh giúp em với ạ, em không hiểu sai chổ nào cả.
Nhấp chuột vào đây để mở rộng...
Lỗi vì các mặt cười, như dòng này
ThisWorkbook.Sheets("Sheet3").Range("A1:D33").Select

Chắc vậy, đoán đại vì nhìn thấy vậy
 
tigertiger đã viết:
Lỗi vì các mặt cười, như dòng này
ThisWorkbook.Sheets("Sheet3").Range("A1:D33").Select

Chắc vậy, đoán đại vì nhìn thấy vậy
Nhấp chuột vào đây để mở rộng...
Đó là lỗi biến 2 hoặc 3 ký tự thành biểu tượng. Dấu hai chấm ":" và chữ "D" là biểu tượng mặt cười. Để tránh thì nên viết cách ra 1 khoảng trắng như : D, viết liền sẽ là :D


Câu lệnh sẽ là Range("A1: D33").Select
 
ptm0412 đã viết:
Để tránh thì nên viết cách ra 1 khoảng trắng như : D
Nhấp chuột vào đây để mở rộng...
Nên cho vào các thẻ [ code] chứ anh.
Vụ này em nói nhiều lắm rồi á. Ở diễn đàn chuyên môn thì cái này là luật bắt buộc, vi phạm là 'auto' xóa luôn.
------
Hỏi thăm: Anh được 'cho' về chưa ạ?
 
ptm0412 đã viết:
Đó là lỗi biến 2 hoặc 3 ký tự thành biểu tượng. Dấu hai chấm ":" và chữ "D" là biểu tượng mặt cười. Để tránh thì nên viết cách ra 1 khoảng trắng như : D, viết liền sẽ là :D
Câu lệnh sẽ là Range("A1: D33").Select
Nhấp chuột vào đây để mở rộng...
Còn nếu là code thì các bạn nên cho vào thẻ code 1601610319881.png
Mã:
để tránh trường hợp này....
 
ptm0412 đã viết:
Đó là lỗi biến 2 hoặc 3 ký tự thành biểu tượng. Dấu hai chấm ":" và chữ "D" là biểu tượng mặt cười. Để tránh thì nên viết cách ra 1 khoảng trắng như : D, viết liền sẽ là :D


Câu lệnh sẽ là Range("A1: D33").Select
Nhấp chuột vào đây để mở rộng...
Ah, ý là nhắc người hỏi nên đặt vào trong tab [ code] ... [ /code]
 
ptm0412 đã viết:
Đó là lỗi biến 2 hoặc 3 ký tự thành biểu tượng. Dấu hai chấm ":" và chữ "D" là biểu tượng mặt cười. Để tránh thì nên viết cách ra 1 khoảng trắng như : D, viết liền sẽ là :D


Câu lệnh sẽ là Range("A1: D33").Select
Nhấp chuột vào đây để mở rộng...
cảm ơn bác nhiều nhé, hi
Bài đã được tự động gộp:

thnghiachau đã viết:
Mình nghĩ rằng để không bị lẫn lộn giữa cái workbook hiện tại với workbook tạo mới thì bạn nên tạo ra 2 biến:
Mã: 
Dim wbNew As Workbook, wbThis As Workbook
Với cái này thì mình viết lại cái code (viết theo mình suy nghĩ là vậy, có thể code không đúng ý đồ của bạn chỗ nào thì bạn chỉnh lại chỗ đó giúp nha...)

Mã: 
Sub Button7_Click()
Dim OutApp As Object, OutMail As Object
Dim printFrom As Variant, printTo As Variant
Dim sFile As String, sPath As String
Dim i As Long
Dim wbNew As Workbook, wbThis As Workbook
    Set wbThis = ThisWorkbook
    printFrom = wbThis.Sheets("Sheet3").Range("I8")
    printTo = wbThis.Sheets("Sheet3").Range("I9")
    Set OutApp = CreateObject("Outlook.Application")
    For i = printFrom To printTo
        wbThis.Sheets("Sheet3").Range("I5") = i
        Set wbNew = Workbooks.Add(xlWBATWorksheet)
      
        wbThis.Sheets("Sheet3").Range("A1:D33").Copy
        With wbNew.Sheets("Sheet1")
            .Range("A1:D33").PasteSpecial xlPasteValues
            .Range("A1:D33").PasteSpecial xlPasteFormats
            .Columns("A:D").AutoFit
        End With
        Application.CutCopyMode = False
      
        sFile = wbThis.Path & "\" & "Payslip Oct 2020 - " & wbThis.Sheets("Sheet3").Range("B11") & ".xlsx"
        wbNew.SaveAs Filename:=sFile, FileFormat:=51, WriteResPassword:="", ReadOnlyRecommended:=True, CreateBackup:=False
        wbNew.Close False
        Set wbNew = Nothing
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = wbThis.Sheets("Sheet3").Range("B12")
            .cc = ""
            .BCC = ""
            .Subject = wbThis.Sheets("Sheet3").Range("B9")
            .HTMLBody = " Dear " & Sheets("Sheet3").Range("B11") & "</B> <BR><BR> Kindly find attachment payslip of October 2020. <BR>" & _
            "<BR>Should you have any questions, do not hestitate to contact us." & _
            "<BR><BR>Thanks & regards</B><BR>" & _
            "</B>"
            .Attachments.Add (sFile)
            .Send
        End With
        Set OutMail = Nothing
    Next i
    Set OutApp = Nothing
    Set OutMail = Nothing
    MsgBox "Success"

End Sub
Nhấp chuột vào đây để mở rộng...


Thanks bác nhé. đúng là ghi rõ ra thì dễ nhìn hơn và dễ phân biệt hơn hẳn
Bài đã được tự động gộp:

huuthang_bd đã viết:
Lúc nãy em không xem các dòng code khác, giờ xem kỹ lại thì lỗi vẫn là do file hiện hành không có Sheet3.
File chứa code thì có Sheet3 nhưng file mới tạo bằng lệnh Workbooks.Add thì không có. Code trỏ đến Sheet3 (bằng SheetName) mà không xác định workbook nên mặc định trỏ đến workbook hiện hành. Khi thêm workbook mới thì workbook mới thành workbook hiện hành, code trỏ đến Sheet3 của workbook hiện hành nhưng không có -> lỗi.
Nếu muốn trỏ đến Sheet3 của workbook chứa code thì viết rõ ThisWorkbook.Sheets("Sheet3"). Ngoài ra, ActiveWorkbook.Path trong dòng lệnh đó luôn trả về.chuỗi rỗng do ActiveWorkbook là workbook chưa được save.
@Chủ topic: Nên tạo thói quen khi trỏ đến đối tượng bằng tên thì chỉ rõ đối tượng cha. Thói quen này giúp code rõ ràng hơn và hạn chế lỗi hoặc code thực thi không đúng ý đồ của người viết code. Lỗi còn biết để mà sửa chứ chạy sai mà không phát hiện được thì hậu quả khôn lường.
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn đã đóng góp ý kiến, chân thành cảm ơn nha
 
befaint đã viết:
Nên cho vào các thẻ [ code] chứ anh.
Vụ này em nói nhiều lắm rồi á. Ở diễn đàn chuyên môn thì cái này là luật bắt buộc, vi phạm là 'auto' xóa luôn.
Nhấp chuột vào đây để mở rộng...
Để giải thích cái mặt cười thôi, còn vụ thẻ [ code] thì mình xài thường nhưng không biết công dụng số 2.
Thử cái coi
PHP: 
Range("A1:D33").Select
befaint đã viết:
Hỏi thăm: Anh được 'cho' về chưa ạ?
Nhấp chuột vào đây để mở rộng...
May quá chỉ ở 4 ngày và về rồi, ở nhà ngồi máy tính mới viết được mấy bài dài dài hay hay chứ post bằng điện thoại chán lắm.
 
thnghiachau đã viết:
Mình nghĩ rằng để không bị lẫn lộn giữa cái workbook hiện tại với workbook tạo mới thì bạn nên tạo ra 2 biến:
Mã: 
Dim wbNew As Workbook, wbThis As Workbook
Với cái này thì mình viết lại cái code (viết theo mình suy nghĩ là vậy, có thể code không đúng ý đồ của bạn chỗ nào thì bạn chỉnh lại chỗ đó giúp nha...)

Mã: 
Sub Button7_Click()
Dim OutApp As Object, OutMail As Object
Dim printFrom As Variant, printTo As Variant
Dim sFile As String, sPath As String
Dim i As Long
Dim wbNew As Workbook, wbThis As Workbook
    Set wbThis = ThisWorkbook
    printFrom = wbThis.Sheets("Sheet3").Range("I8")
    printTo = wbThis.Sheets("Sheet3").Range("I9")
    Set OutApp = CreateObject("Outlook.Application")
    For i = printFrom To printTo
        wbThis.Sheets("Sheet3").Range("I5") = i
        Set wbNew = Workbooks.Add(xlWBATWorksheet)
      
        wbThis.Sheets("Sheet3").Range("A1:D33").Copy
        With wbNew.Sheets("Sheet1")
            .Range("A1:D33").PasteSpecial xlPasteValues
            .Range("A1:D33").PasteSpecial xlPasteFormats
            .Columns("A:D").AutoFit
        End With
        Application.CutCopyMode = False
      
        sFile = wbThis.Path & "\" & "Payslip Oct 2020 - " & wbThis.Sheets("Sheet3").Range("B11") & ".xlsx"
        wbNew.SaveAs Filename:=sFile, FileFormat:=51, WriteResPassword:="", ReadOnlyRecommended:=True, CreateBackup:=False
        wbNew.Close False
        Set wbNew = Nothing
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = wbThis.Sheets("Sheet3").Range("B12")
            .cc = ""
            .BCC = ""
            .Subject = wbThis.Sheets("Sheet3").Range("B9")
            .HTMLBody = " Dear " & Sheets("Sheet3").Range("B11") & "</B> <BR><BR> Kindly find attachment payslip of October 2020. <BR>" & _
            "<BR>Should you have any questions, do not hestitate to contact us." & _
            "<BR><BR>Thanks & regards</B><BR>" & _
            "</B>"
            .Attachments.Add (sFile)
            .Send
        End With
        Set OutMail = Nothing
    Next i
    Set OutApp = Nothing
    Set OutMail = Nothing
    MsgBox "Success"

End Sub
Nhấp chuột vào đây để mở rộng...


Bạn ơi, cho mình hỏi mình có tạo một folder với mã :
Set fso = CreateObject("Scripting.FileSystemObject")
FName = ThisWorkbook.Path & "\PhieuLuong - " & Format(Now, "MMM DD YY")
If fso.FolderExists(FName) Then
fso.CreateFolder (FName)
End If


Và mình chỉnh sữa lệnh :sFile = FName & "\" & "Payslip Oct 2020 - " & wbThis.Sheets("Sheet3").Range("B11") & ".xlsx"
Nó báo lỗi : run-time error '1004' Microsoft excel cannot access the file.
Giải thích hộ mình với ạ.
Bài đã được tự động gộp:

duongvanminh33 đã viết:
Bạn ơi, cho mình hỏi mình có tạo một folder với mã :
Set fso = CreateObject("Scripting.FileSystemObject")
FName = ThisWorkbook.Path & "\PhieuLuong - " & Format(Now, "MMM DD YY")
If fso.FolderExists(FName) Then
fso.CreateFolder (FName)
End If


Và mình chỉnh sữa lệnh :sFile = FName & "\" & "Payslip Oct 2020 - " & wbThis.Sheets("Sheet3").Range("B11") & ".xlsx"
Nó báo lỗi : run-time error '1004' Microsoft excel cannot access the file.
Giải thích hộ mình với ạ.
Nhấp chuột vào đây để mở rộng...
Lỗi sai : wbNew.SaveAs Filename:=sFile, FileFormat:=51, WriteResPassword:="", ReadOnlyRecommended:=True, CreateBackup:=False
 
duongvanminh33 đã viết:
Bạn ơi, cho mình hỏi mình có tạo một folder với mã :
Set fso = CreateObject("Scripting.FileSystemObject")
FName = ThisWorkbook.Path & "\PhieuLuong - " & Format(Now, "MMM DD YY")
If fso.FolderExists(FName) Then
fso.CreateFolder (FName)
End If


Và mình chỉnh sữa lệnh :sFile = FName & "\" & "Payslip Oct 2020 - " & wbThis.Sheets("Sheet3").Range("B11") & ".xlsx"
Nó báo lỗi : run-time error '1004' Microsoft excel cannot access the file.
Giải thích hộ mình với ạ.
Nhấp chuột vào đây để mở rộng...
bạn dưa lên hết code bạn viêt lên, chứ mà nói khơi khơi mình không biết sao nữa ah...

NHẮC LẠI: nhớ khi đưa code lên thì phải đặt trong thẻ code nha (xem bài #10)
 
thnghiachau đã viết:
bạn dưa lên hết code bạn viêt lên, chứ mà nói khơi khơi mình không biết sao nữa ah...

NHẮC LẠI: nhớ khi đưa code lên thì phải đặt trong thẻ code nha (xem bài #10)
Nhấp chuột vào đây để mở rộng...
Mình có tạo một folder và muốn tạo file theo vòng lặp . lưu file vô folder đó lun.
Mã: 
Sub Button7_Click()
Dim OutApp As Object, OutMail As Object
Dim printFrom As Variant, printTo As Variant
Dim sFile As String, sPath As String
Dim i As Long
Dim FName As String
Dim fso As Object
Dim wbNew As Workbook, wbThis As Workbook
    FName = ThisWorkbook.Path & "\PhieuLuong - " & Format(Now, "MMM DD YY")
     Const DeleteReadOnly = True
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists(FName) Then
        fso.DeleteFolder (FName), DeleteReadOnly
        fso.CreateFolder (FName)
    End If
    If Not fso.FolderExists(FName) Then
        fso.CreateFolder (FName)
    End If
    Set wbThis = ThisWorkbook
    printFrom = wbThis.Sheets("Sheet3").Range("I8")
    printTo = wbThis.Sheets("Sheet3").Range("I9")
    Set OutApp = CreateObject("Outlook.Application")
    For i = printFrom To printTo
        wbThis.Sheets("Sheet3").Range("I5") = i
        Set wbNew = Workbooks.Add(xlWBATWorksheet)
      
        wbThis.Sheets("Sheet3").Range("A1: D33").Copy
        With wbNew.Sheets("Sheet1")
            .Range("A1: D33").PasteSpecial xlPasteValues
            .Range("A1: D33").PasteSpecial xlPasteFormats
            .Columns("A:D").AutoFit
        End With
        Application.CutCopyMode = False
      
        sFile = FName & "\" & "Payslip Oct 2020 - " & wbThis.Sheets("Sheet3").Range("B11") & ".xlsx"
        wbNew.SaveAs Filename:=sFile, FileFormat:=51, WriteResPassword:="", ReadOnlyRecommended:=True, CreateBackup:=False
        wbNew.Close False
        Set wbNew = Nothing
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = wbThis.Sheets("Sheet3").Range("B12")
            .cc = ""
            .BCC = ""
            .Subject = wbThis.Sheets("Sheet3").Range("B9")
            .HTMLBody = " Dear " & Sheets("Sheet3").Range("B11") & "</B> <BR><BR> Kindly find attachment payslip of October 2020. <BR>" & _
            "<BR>Should you have any questions, do not hestitate to contact us." & _
            "<BR><BR>Thanks & regards</B><BR>" & _
            "</B>"
            .Attachments.Add (sFile)
            'ActiveWorkbook.FullName
            
            .Send
        End With
        Set OutMail = Nothing
    Next i
    Set OutApp = Nothing
    Set OutMail = Nothing
    MsgBox "Success"

End Sub
Bài đã được tự động gộp:

thnghiachau đã viết:
bạn dưa lên hết code bạn viêt lên, chứ mà nói khơi khơi mình không biết sao nữa ah...

NHẮC LẠI: nhớ khi đưa code lên thì phải đặt trong thẻ code nha (xem bài #10)
Nhấp chuột vào đây để mở rộng...
sr bạn, mình chạy được code rùi, mà bạn ơi, có cách nào để tạo mật khẩu chạy theo bảng dữ liệu như to và from không bạn,
 
Lần chỉnh sửa cuối:
duongvanminh33 đã viết:
Mình có tạo một folder và muốn tạo file theo vòng lặp . lưu file vô folder đó lun.
Mã: 
Sub Button7_Click()
Dim OutApp As Object, OutMail As Object
Dim printFrom As Variant, printTo As Variant
Dim sFile As String, sPath As String
Dim i As Long
Dim FName As String
Dim fso As Object
Dim wbNew As Workbook, wbThis As Workbook
    FName = ThisWorkbook.Path & "\PhieuLuong - " & Format(Now, "MMM DD YY")
     Const DeleteReadOnly = True
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists(FName) Then
        fso.DeleteFolder (FName), DeleteReadOnly
        fso.CreateFolder (FName)
    End If
    If Not fso.FolderExists(FName) Then
        fso.CreateFolder (FName)
    End If
    Set wbThis = ThisWorkbook
    printFrom = wbThis.Sheets("Sheet3").Range("I8")
    printTo = wbThis.Sheets("Sheet3").Range("I9")
    Set OutApp = CreateObject("Outlook.Application")
    For i = printFrom To printTo
        wbThis.Sheets("Sheet3").Range("I5") = i
        Set wbNew = Workbooks.Add(xlWBATWorksheet)
     
        wbThis.Sheets("Sheet3").Range("A1: D33").Copy
        With wbNew.Sheets("Sheet1")
            .Range("A1: D33").PasteSpecial xlPasteValues
            .Range("A1: D33").PasteSpecial xlPasteFormats
            .Columns("A:D").AutoFit
        End With
        Application.CutCopyMode = False
     
        sFile = FName & "\" & "Payslip Oct 2020 - " & wbThis.Sheets("Sheet3").Range("B11") & ".xlsx"
        wbNew.SaveAs Filename:=sFile, FileFormat:=51, WriteResPassword:="", ReadOnlyRecommended:=True, CreateBackup:=False
        wbNew.Close False
        Set wbNew = Nothing
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = wbThis.Sheets("Sheet3").Range("B12")
            .cc = ""
            .BCC = ""
            .Subject = wbThis.Sheets("Sheet3").Range("B9")
            .HTMLBody = " Dear " & Sheets("Sheet3").Range("B11") & "</B> <BR><BR> Kindly find attachment payslip of October 2020. <BR>" & _
            "<BR>Should you have any questions, do not hestitate to contact us." & _
            "<BR><BR>Thanks & regards</B><BR>" & _
            "</B>"
            .Attachments.Add (sFile)
            'ActiveWorkbook.FullName
           
            .Send
        End With
        Set OutMail = Nothing
    Next i
    Set OutApp = Nothing
    Set OutMail = Nothing
    MsgBox "Success"

End Sub
Nhấp chuột vào đây để mở rộng...
Ngộ vậy ta? mình chạy code này vèo vèo mà? không có bị gì hết ah....
""":::":\
Bài đã được tự động gộp:

duongvanminh33 đã viết:
Mình có tạo một folder và muốn tạo file theo vòng lặp . lưu file vô folder đó lun.
Mã: 
Sub Button7_Click()
Dim OutApp As Object, OutMail As Object
Dim printFrom As Variant, printTo As Variant
Dim sFile As String, sPath As String
Dim i As Long
Dim FName As String
Dim fso As Object
Dim wbNew As Workbook, wbThis As Workbook
    FName = ThisWorkbook.Path & "\PhieuLuong - " & Format(Now, "MMM DD YY")
     Const DeleteReadOnly = True
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists(FName) Then
        fso.DeleteFolder (FName), DeleteReadOnly
        fso.CreateFolder (FName)
    End If
    If Not fso.FolderExists(FName) Then
        fso.CreateFolder (FName)
    End If
    Set wbThis = ThisWorkbook
    printFrom = wbThis.Sheets("Sheet3").Range("I8")
    printTo = wbThis.Sheets("Sheet3").Range("I9")
    Set OutApp = CreateObject("Outlook.Application")
    For i = printFrom To printTo
        wbThis.Sheets("Sheet3").Range("I5") = i
        Set wbNew = Workbooks.Add(xlWBATWorksheet)
     
        wbThis.Sheets("Sheet3").Range("A1: D33").Copy
        With wbNew.Sheets("Sheet1")
            .Range("A1: D33").PasteSpecial xlPasteValues
            .Range("A1: D33").PasteSpecial xlPasteFormats
            .Columns("A:D").AutoFit
        End With
        Application.CutCopyMode = False
     
        sFile = FName & "\" & "Payslip Oct 2020 - " & wbThis.Sheets("Sheet3").Range("B11") & ".xlsx"
        wbNew.SaveAs Filename:=sFile, FileFormat:=51, WriteResPassword:="", ReadOnlyRecommended:=True, CreateBackup:=False
        wbNew.Close False
        Set wbNew = Nothing
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = wbThis.Sheets("Sheet3").Range("B12")
            .cc = ""
            .BCC = ""
            .Subject = wbThis.Sheets("Sheet3").Range("B9")
            .HTMLBody = " Dear " & Sheets("Sheet3").Range("B11") & "</B> <BR><BR> Kindly find attachment payslip of October 2020. <BR>" & _
            "<BR>Should you have any questions, do not hestitate to contact us." & _
            "<BR><BR>Thanks & regards</B><BR>" & _
            "</B>"
            .Attachments.Add (sFile)
            'ActiveWorkbook.FullName
           
            .Send
        End With
        Set OutMail = Nothing
    Next i
    Set OutApp = Nothing
    Set OutMail = Nothing
    MsgBox "Success"

End Sub
Bài đã được tự động gộp:


sr bạn, mình chạy được code rùi, mà bạn ơi, có cách nào để tạo mật khẩu chạy theo bảng dữ liệu như to và from không bạn,
Nhấp chuột vào đây để mở rộng...
xin lỗi mình hổng hiểu ý bạn là gì???? có thể nói rõ hơn đươc không?
 
duongvanminh33 đã viết:
Mình có tạo một folder và muốn tạo file theo vòng lặp . lưu file vô folder đó lun.
Mã: 
    Set wbThis = ThisWorkbook

        Set wbNew = Workbooks.Add(xlWBATWorksheet)
Nhấp chuột vào đây để mở rộng...
Đặt tên biến nếu viết tắt từ tiếng Anh thì phải theo văn phạm tiếng Anh, ThisWb (this workbook) và NewWb (new workbook) chứ sao lại ngược thế kia
 
thnghiachau đã viết:
Ngộ vậy ta? mình chạy code này vèo vèo mà? không có bị gì hết ah....
""":::":\
Bài đã được tự động gộp:


xin lỗi mình hổng hiểu ý bạn là gì???? có thể nói rõ hơn đươc không?
Nhấp chuột vào đây để mở rộng...
ý là mình có một bảng dữ liệu trong đó mình có cột dữ liệu chứa các mật khẩu, và mình muốn lấy mk để gán cho từng file , mình đã thử tuy nhiên chỉ hỉu được một mk dòng thui
Bài đã được tự động gộp:

ptm0412 đã viết:
Đặt tên biến nếu viết tắt từ tiếng Anh thì phải theo văn phạm tiếng Anh, ThisWb (this workbook) và NewWb (new workbook) chứ sao lại ngược thế kia
Nhấp chuột vào đây để mở rộng...
À sr bạn, mình sẽ sữa lại code.
 
ptm0412 đã viết:
Đặt tên biến nếu viết tắt từ tiếng Anh thì phải theo văn phạm tiếng Anh, ThisWb (this workbook) và NewWb (new workbook) chứ sao lại ngược thế kia
Nhấp chuột vào đây để mở rộng...
Dạ, cái này là của em chứ không phải của bạn @duongvanminh33 ạ.
tại em theo qui tắc riếng của em là tiếp đầu ngữ của biến là kiểu biến và tiếp theo là cái tên thể hiện.
ví dụ: wbThis có nghĩa là: wb=> kiểu là Workbook và This có nghĩa là ThisWorkBook
Bài đã được tự động gộp:

duongvanminh33 đã viết:
ý là mình có một bảng dữ liệu trong đó mình có cột dữ liệu chứa các mật khẩu, và mình muốn lấy mk để gán cho từng file , mình đã thử tuy nhiên chỉ hỉu được một mk dòng thui
Nhấp chuột vào đây để mở rộng...
Mình thấy bạn đã làm việc thay đổi giá trị tại Cell I5 của Sheet3 bằng câu lệnh "wbThis.Sheets("Sheet3").Range("I5") = i" mà???
thế thì cái mật khẩu cho từng hàng dữ liệu thì cũng giống y chang các dữ liệu được điền vào khi thay đổi giá trị tại Cell I5 thôi!!!
 
Lần chỉnh sửa cuối:
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

00029591
Cần hỗ trợ công thức tổng hợp dữ liệu không cần cột phụ Vlookup
Trả lời
3
Đọc
111
tle2003
T
D
  • Đã giải quyết
Quản lý email outlook qua VBA cần giúp đỡ
2
Trả lời
22
Đọc
429
nguyendang95
N
G
Xin Code xóa Module.
Trả lời
7
Đọc
206
VetMini
V
S
Mở 2 cửa sổ riêng biệt (1 người xem)
2
Trả lời
30
Đọc
23K
sakuraluu
S
F
Nhập dấu . (chấm) ở bàn phím phụ không tự chuyển thành dấu , (phẩy) (1 người xem)
Trả lời
16
Đọc
57K
tubaodn21
tubaodn21
PhanTuHuong
Sách Lập trình VBA trong AutoCAD đã có mặt
    • Thích
    • Yêu thích
2
Trả lời
21
Đọc
1K
PhanTuHuong
PhanTuHuong
L
Lỗi font khi convert từ pdf
Trả lời
3
Đọc
134
lamvu0677
L
N
Khắc phục lỗi "The picture is too large and will be truncated" (1 người xem)
Trả lời
9
Đọc
5K
SonBDND
S
GPE-Trợ Lý
[GPE] TALKSHOW: PHÂN TÍCH BÁO CÁO ĐỘ NHẠY SỬ DỤNG EXCEL SOLVER (1 người xem)
    • Thích
Trả lời
0
Đọc
936
GPE-Trợ Lý
GPE-Trợ Lý
K
  • Question Question
nhờ ace giúp đỡ tự động filter và In hàng loạt từng mục trong piviot table (1 người xem)
Trả lời
1
Đọc
109
khkkh
K
K
Xin dax tính tỷ trọng doanh thu
Trả lời
18
Đọc
783
SteveNguyen1991
S
F
  • Question Question
Tự động Merge Mail bằng VBA
Trả lời
6
Đọc
210
Hoàng Tuấn 868
H
N
Một ví dụ về XLL add-in: Tương tác với Google Gemini dưới dạng công thức bảng tính
    • Thích
Trả lời
0
Đọc
133
nguyendang95
N
H
Nhờ anh/chị giúp đỡ em viết công thức trừ dữ liệu theo FiFo
Trả lời
1
Đọc
119
HieuCD
H
BNTT
LockXLS - Chương trình bảo vệ an toàn cho các file bảng tính Excel (1 người xem)
    • Thích
4 5 6
Trả lời
118
Đọc
73K
YêuCN
Y
vsitcnh
Hỗ trợ công thức tính điểm dựa theo điều kiện. (1 người xem)
Trả lời
14
Đọc
213
thuytrangbp28
T
micam111
  • Question Question
Cách chạy nhiều đồng hồ đếm giờ trong VBA
Trả lời
4
Đọc
705
thuytrangbp28
T
B
Xin giải pháp chống sửa, xóa dữ liệu đã nhập vào từ ngày hôm trước. (2 người xem)
    • Thích
2
Trả lời
26
Đọc
7K
Tuấn Bụng Bự
Tuấn Bụng Bự
Emyeuexcel
  • Question Question
In tất cả các file trong cùng 1 thư mục
Trả lời
3
Đọc
219
Hoàng Tuấn 868
H
1
Hỏi về đánh dấu hàng ngang hàng dọc bằng màu khi kích chuột vào 1 ô
Trả lời
7
Đọc
214
Gà Công Nghệ
Gà Công Nghệ
Xem thêm…

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

000
Ngày
00
Giờ
00
phút
00
giây
TALK SHOW: CÙNG NHẢY LAM BA ĐA VỚI HÀM LAMBDA (λ) EXCEL 365
Back
Top Bottom