Kiến Thức - [Mẹo VBA] Cách Hiển Thị Tiếng Việt Trong Hộp Thoại MsgBox

• Forums New posts
• Latests Featured content New posts New profile posts Latest activity

Log in Register What's new

• New posts

Menu Log in Register Install the app Install How to install the app on iOS

Follow along with the video below to see how to install our site as a web app on your home screen.

Note: This feature may not be available in some browsers.

• Forums
• Phần mềm & Games
• Phần mềm

You are using an out of date browser. It may not display this or other websites correctly.You should upgrade or use an alternative browser. kiến thức[Mẹo VBA] Cách hiển thị tiếng Việt trong hộp thoại MsgBox

• Thread starter Thread starter NguyenDang95
• Start date Start date Dec 14, 2021

• 1
• 2

Next 1 of 2

Go to page

Go Next Last

NguyenDang95

Senior Member

Chào mọi người, như đã biết VBA không hỗ trợ gõ tiếng Việt trong cửa sổ lập trình VBE nên việc hiển thị hộp thoại tiếng Việt trong hộp thoại MsgBox là điều bất khả thi. Ngoài việc dùng hàm chuyển đổi Unicode của một số diễn đàn chuyên về VBA, bằng kiến thức ít ỏi của bản thân tôi cũng xin đóng góp một cách đơn giản như sau:

• Tạo một tệp .txt với cấu trúc “label: nội dung”, lưu với encoding UTF-16

• Viết hàm PairTextLinePair (sẽ trình bày ở ví dụ bên dưới) tìm label (bên trái dấu “:”, nếu tìm được thì trả về chuỗi nằm bên phải dấu “:”)
• Tùy biến hàm MsgBox để hỗ trợ hiển thị ký tự Unicode nhờ API MessageBoxW, GetFocus
• Dùng đối tượng Scripting.FileSystemObject, đọc toàn bộ tệp .txt, trả kết quả cho hàm PairTextLinePair

Ví dụ: Hiển thị hộp thoại nhắc người dùng đính kèm tệp vào mail trước khi gửi trong Outlook. Code: Option Explicit #If VBA7 Then Private Declare PtrSafe Function MessageBoxW Lib "user32" (ByVal hWnd As LongPtr, ByVal lpText As LongPtr, ByVal lpCaption As LongPtr, ByVal uType As Long) As Long Private Declare PtrSafe Function GetFocus Lib "user32" () As LongPtr Private Declare PtrSafe Function MessageBeep Lib "user32" (ByVal wType As Long) As Long #Else Private Declare Function MessageBoxW Lib "user32" (ByVal hWnd As Long, ByVal lpText As Long, ByVal lpCaption As Long, ByVal uType As Long) As Long Private Declare Function GetFocus Lib "user32" () As Long Private Declare Function MessageBeep Lib "user32" (ByVal wType As Long) As Long #End If Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) Dim objItem As Outlook.MailItem If TypeOf Item Is Outlook.MailItem Then Set objItem = Item If CancelNoAttachments(objItem) Then Cancel = True End If Set objItem = Nothing End Sub Private Function CancelNoAttachments(ByVal objItem As Outlook.MailItem) As Boolean Dim strMsg As String Dim strMsgSet As String Dim strKeyword1 As String Dim strKeyword2 As String Dim strPath As String Dim intPos1 As Integer Dim intPos2 As Integer Dim fso As Object Dim fsoFile As Object strPath = "C:\Outlook-msgbox.txt" Set fso = CreateObject("Scripting.FileSystemObject") Set fsoFile = fso.OpenTextFile(strPath, 1, False, -1) strMsgSet = fsoFile.ReadAll fsoFile.Close If objItem.Attachments.Count = 0 Then strKeyword1 = ParseTextLinePair(strMsgSet, "attached:") strKeyword2 = ParseTextLinePair(strMsgSet, "Attached:") intPos1 = InStr(1, objItem.Body, strKeyword1) intPos2 = InStr(1, objItem.Body, strKeyword2) If intPos1 > 0 Or intPos2 > 0 Then strMsg = ParseTextLinePair(strMsgSet, "Check for attachments:") If MsgBoxW(strMsg, vbQuestion + vbYesNo, "Add attachments?") = vbYes Then CancelNoAttachments = True End If End If Set fso = Nothing Set fsoFile = Nothing End Function ‘Tùy biến hàm MsgBox để hỗ trợ hiển thị ký tự Unicode Function MsgBoxW(Prompt As String, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Title As String = "Microsoft Outlook") As VbMsgBoxResult Select Case Buttons Case vbInformation MessageBeep (&H10) Case vbQuestion MessageBeep (&H20) Case vbExclamation MessageBeep (&H30) Case vbCritical MessageBeep (&H40) Case Else MessageBeep (&H0) End Select MsgBoxW = MessageBoxW(GetFocus(), StrPtr(Prompt), StrPtr(Title), Buttons) End Function Function ParseTextLinePair(strSource As String, strLabel As String) Dim intLocLabel As Integer Dim intLocCRLF As Integer Dim intLenLabel As Integer Dim strText As String 'Lay vi tri cua chuoi ky tu label trong van ban nguon intLocLabel = InStr(1, strSource, strLabel) 'Tinh do dai chuoi ky tu label intLenLabel = Len(strLabel) 'Neu ton tai chuoi ky tu label thi thuc hien buoc tiep theo If intLocLabel > 0 Then 'Tim vi tri ky tu xuong dong, bat dau tu vi tri chuoi ky tu label intLocCRLF = InStr(intLocLabel, strSource, vbCrLf) 'Tien hanh tach chuoi label If intLocCRLF > 0 Then intLocLabel = intLocLabel + intLenLabel strText = Mid(strSource, intLocLabel, intLocCRLF - intLocLabel) Else: strText = Mid(strSource, intLocLabel + intLenLabel) End If End If ParseTextLinePair = Trim(strText) End Function Kết quả: Last edited: Feb 28, 2022 H

Harry James Potter

Đã tốn tiền

Thím code đoạn mà trước khi gửi mail thì check lại danh sách người gửi, cc, bcc được không

NguyenDang95

Senior Member

Harry James Potter said: Thím code đoạn mà trước khi gửi mail thì check lại danh sách người gửi, cc, bcc được không Click to expand...

Ý bác là trước khi gửi mail thì hiển thị thông báo kiểm tra lại danh sách người gửi, cc, bcc xem có sai sót gì, nếu người dùng bấm Yes là gửi đi đúng không bác? H

Harry James Potter

Đã tốn tiền

NguyenDang95 said: Ý bác là trước khi gửi mail thì hiển thị thông báo kiểm tra lại danh sách người gửi, cc, bcc xem có sai sót gì, nếu người dùng bấm Yes là gửi đi đúng không bác? Click to expand...

Chuẩn rồi thím Lâu rồi không động vào VBA thấy cái thread của thím cũng ham mà mấy cái cú pháp của VBA lười quá

NguyenDang95

Senior Member

Harry James Potter said: Chuẩn rồi thím Lâu rồi không động vào VBA thấy cái thread của thím cũng ham mà mấy cái cú pháp của VBA lười quá Click to expand...

Code đơn giản thôi thím: Đưa thủ tục dưới đây đặt vào ThisOutlookSession, khởi động lại Outlook là xong. Code: Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) If TypeOf Item Is Outlook.MailItem Then If MsgBox("Hay kiem tra lai danh sach nguoi gui, cc, bcc truoc khi xac nhan gui mail di." & vbCrLf & "Ban chac chan muon gui mail den (nhung) nguoi nhan nay?", vbQuestion + vbYesNo, "Check Recipients Before Sending") = vbYes Then Cancel = False Else: Cancel = True End If End If End Sub Kết quả: H

Harry James Potter

Đã tốn tiền

NguyenDang95 said: Code đơn giản thôi thím: Đưa thủ tục dưới đây đặt vào ThisOutlookSession, khởi động lại Outlook là xong. Code: Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) If TypeOf Item Is Outlook.MailItem Then If MsgBox("Hay kiem tra lai danh sach nguoi gui, cc, bcc truoc khi xac nhan gui mail di." & vbCrLf & "Ban chac chan muon gui mail den (nhung) nguoi nhan nay?", vbQuestion + vbYesNo, "Check Recipients Before Sending") = vbYes Then Cancel = False Else: Cancel = True End If End If End Sub Kết quả: View attachment 922199 Click to expand...

Có làm cách nào mà list ra hết được không thím? Ví dụ Check sending address To: Mr A [email protected], Mr B [email protected] Cc: Ms C [email protected] Bcc: Mrs D [email protected]

NguyenDang95

Senior Member

Harry James Potter said: Có làm cách nào mà list ra hết được không thím? Ví dụ Check sending address To: Mr A [email protected], Mr B [email protected] Cc: Ms C [email protected] Bcc: Mrs D [email protected] Click to expand...

Bác phải lưu email người nhận vào Contacts thì mới hiện tên người nhận nhé, không thì Outlook chỉ hiển thị mỗi địa chỉ email. Code: Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) Dim objMail As Outlook.MailItem Dim objRecip As Outlook.Recipient Dim colRecips As Outlook.Recipients Dim strRecipAddr As String Dim strCCAddr As String Dim strBCCAddr As String Dim strRecipName As String Dim strCCName As String Dim strBCCName As String If TypeOf Item Is Outlook.MailItem Then Set objMail = Item Set colRecips = objMail.Recipients For Each objRecip In colRecips With objRecip .Resolve If .Resolved Then Select Case .Type Case olTo strRecipAddr = .Address strRecipName = .Name Case olCC strCCAddr = .Address strCCName = .Name Case olBCC strBCCAddr = .Address strBCCName = .Name End Select End If End With Next If MsgBox("Hay kiem tra lai danh sach nguoi gui, cc, bcc truoc khi xac nhan gui mail di." & vbCrLf & _ "Ban chac chan muon gui mail den (nhung) nguoi nhan nay?" & vbCrLf & vbCrLf & _ "Nguoi nhan :" & strRecipName & " " & strRecipAddr & vbCrLf & _ "CC: " & strCCName & " " & strCCAddr & vbCrLf & _ "BCC: " & strBCCName & " " & strBCCAddr, vbQuestion + vbYesNo, "Check Recipients Before Sending") = vbYes Then Cancel = False Else: Cancel = True End If End If Set objMail = Nothing Set objRecip = Nothing Set colRecips = Nothing End Sub Kết quả: Last edited: Dec 14, 2021 H

Harry James Potter

Đã tốn tiền

NguyenDang95 said: Bác phải lưu email người nhận vào Contacts thì mới hiện tên người nhận nhé, không thì Outlook chỉ hiển thị mỗi địa chỉ email. Code: Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) Dim objMail As Outlook.MailItem Dim objRecip As Outlook.Recipient Dim colRecips As Outlook.Recipients Dim strRecipAddr As String Dim strCCAddr As String Dim strBCCAddr As String Dim strRecipName As String Dim strCCName As String Dim strBCCName As String If TypeOf Item Is Outlook.MailItem Then Set objMail = Item Set colRecips = objMail.Recipients For Each objRecip In colRecips With objRecip .Resolve If .Resolved Then Select Case .Type Case olTo strRecipAddr = .Address strRecipName = .Name Case olCC strCCAddr = .Address strCCName = .Name Case olBCC strBCCAddr = .Address strBCCName = .Name End Select End If End With Next If MsgBox("Hay kiem tra lai danh sach nguoi gui, cc, bcc truoc khi xac nhan gui mail di." & vbCrLf & _ "Ban chac chan muon gui mail den (nhung) nguoi nhan nay?" & vbCrLf & vbCrLf & _ "Nguoi nhan :" & strRecipName & " " & strRecipAddr & vbCrLf & _ "CC: " & strCCName & " " & strCCAddr & vbCrLf & _ "BCC: " & strBCCName & " " & strBCCAddr, vbQuestion + vbYesNo, "Check Recipients Before Sending") = vbYes Then Cancel = False Else: Cancel = True End If End If Set objMail = Nothing End Sub Kết quả: View attachment 922279 Click to expand...

Cám ơn thím. Cơ mà sao mình add thử cái code bên kia vào không được nhỉ. Hay Office 365 Business không được nhỉ.

NguyenDang95

Senior Member

Harry James Potter said: Cám ơn thím. Cơ mà sao mình add thử cái code bên kia vào không được nhỉ. Hay Office 365 Business không được nhỉ. Click to expand...

Bác phải để code trong ThisOutlookSession là được mà, bản nào chạy đều được hết. Last edited: Dec 14, 2021 H

Harry James Potter

Đã tốn tiền

NguyenDang95 said: Bác phải để code trong ThisOutlookSession là được mà, bản nào chạy đều được hết. View attachment 922345 Click to expand...

Đây thím. Cũng đã enable các kiểu trong security setting rồi.

NguyenDang95

Senior Member

Harry James Potter said: View attachment 922350 Đây thím. Cũng đã enable các kiểu trong security setting rồi. Click to expand...

Bác viết code trong đó xong nhớ khởi động lại Outlook thì mới chạy nhé. H

Harry James Potter

Đã tốn tiền

NguyenDang95 said: Bác viết code trong đó xong nhớ khởi động lại Outlook thì mới chạy nhé. Click to expand...

À được rồi thím ạ. Sau khi chỉnh xong security setting thì phải chạy lại mới được. Cám ơn thím nhé. H

Harry James Potter

Đã tốn tiền

@NguyenDang95 có bug thím ơi. Nếu mà danh sách người gửi nhiều thì nó chỉ hiện cái cuối cùng thôi

NguyenDang95

Senior Member

Harry James Potter said: @NguyenDang95 có bug thím ơi. Nếu mà danh sách người gửi nhiều thì nó chỉ hiện cái cuối cùng thôi Click to expand...

Sorry thím nha Nãy em không để ý là sẽ có trường hợp người gửi nhiều hơn một Code: Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) Dim objMail As Outlook.MailItem Dim objRecip As Outlook.Recipient Dim colRecips As Outlook.Recipients Dim arrTo() Dim arrCC() Dim arrBCC() Dim strRecipAddr As String Dim strCCAddr As String Dim strBCCAddr As String Dim strRecipName As String Dim strCCName As String Dim strBCCName As String Dim i, j, k As Integer If TypeOf Item Is Outlook.MailItem Then Set objMail = Item Set colRecips = objMail.Recipients For Each objRecip In colRecips With objRecip .Resolve If .Resolved Then Select Case .Type Case olTo i = i + 1 strRecipAddr = .Address strRecipName = .Name ReDim Preserve arrTo(1 To i) arrTo(i) = strRecipName & " " & strRecipAddr Case olCC j = j + 1 strCCAddr = .Address strCCName = .Name ReDim Preserve arrCC(1 To j) arrCC(j) = strCCName & " " & strCCAddr Case olBCC k = k + 1 strBCCAddr = .Address strBCCName = .Name ReDim Preserve arrBCC(1 To k) arrBCC(k) = strBCCName & " " & strBCCAddr End Select End If End With Next If MsgBox("Hay kiem tra lai danh sach nguoi gui, cc, bcc truoc khi xac nhan gui mail di." & vbCrLf & _ "Ban chac chan muon gui mail den (nhung) nguoi nhan nay?" & vbCrLf & vbCrLf & _ "Nguoi nhan: " & Join(arrTo, " ") & vbCrLf & _ "CC: " & Join(arrCC, " ") & vbCrLf & _ "BCC: " & Join(arrBCC, " "), vbQuestion + vbYesNo, "Check Recipients Before Sending") = vbYes Then Cancel = False Else: Cancel = True End If End If Set objMail = Nothing Set objRecip = Nothing Set colRecips = Nothing End Sub Kết quả: Last edited: Dec 14, 2021

Captain_US

Senior Member

NguyenDang95 said: Bác phải để code trong ThisOutlookSession là được mà, bản nào chạy đều được hết. View attachment 922345 Click to expand...

Thớt rành về outlook quá sẵn cho mình hỏi ké luôn vấn đề không liên quan lắm. Mình dùng office 365 mà outlook nó không cho thêm gmail. Cứ chọn thêm gmail là nó hiện cái giao diện đăng nhập rất cũ của google, nhập xong mật khẩu thì google báo là không thể đăng nhập. Mình google search thì thấy bảo là phải đăng nhập bằng mật khẩu ứng dụng gì đấy.

NguyenDang95

Senior Member

Captain_US said: Thớt rành về outlook quá sẵn cho mình hỏi ké luôn vấn đề không liên quan lắm. Mình dùng office 365 mà outlook nó không cho thêm gmail. Cứ chọn thêm gmail là nó hiện cái giao diện đăng nhập rất cũ của google, nhập xong mật khẩu thì google báo là không thể đăng nhập. Mình google search thì thấy bảo là phải đăng nhập bằng mật khẩu ứng dụng gì đấy. Click to expand...

Thím làm theo hướng dẫn này là được á, căn bản do thằng Google bắt phải mở xác thực hai bước thì mới cho phép đăng nhập trên Outlook. https://support.microsoft.com/en-us...-outlook-70191667-9c52-4581-990e-e30318c2c081

tornado

Senior Member

Nhìn cái cú pháp của VBA hết muốn dùng

NguyenDang95

Senior Member

tornado said: Nhìn cái cú pháp của VBA hết muốn dùng Click to expand...

Nhưng mà học VBA giúp công việc nhàn hơn

bluestreak5

Senior Member

có cách nào hẹn giờ gửi mail trên outlook, tự động bcc bản thân mỗi khi gửi mail không fen, mình dùng office 365

Green Lantern_Hal Jordan

Senior Member

Ông thớt làm gì dài dòng thế Tạo 1 sheet mới coi như là sheet hệ thống. Tạo 01 bảng trong sheet đó bao gồm các cột : stt, tiêu đề, nội dung. Rồi viết code này

Sub MyMsgBox(stt As Integer) Application.Assistant.DoAlert Application.WorksheetFunction.VLookup(stt, [TênBảng], 2, 0) _ , Application.WorksheetFunction.VLookup(stt, [TênBảng], 3, 0), _ msoAlertButtonOK, msoAlertIconInfo, 0, 0, 0 End Sub Click to expand...

Rồi sau đó cần dùng thì cứ thêm vào bảng hệ thống đó, rồi gọi ra thôi. Ví dụ : stt tiêu đề nội dung 1 thông báo 1 nội dung 1 2 thông báo 2 nội dung 2 3 thông báo 3 nội dung 3 4 thông báo 4 nội dung 4 5 thông báo 5 nội dung 5 Lấy cái nào thì gõ Call MyMsgbox(1) là xong

• 1
• 2

Next 1 of 2

Go to page

Go Next Last You must log in or register to reply here.

Similar threads

thắc mắc VBA - đẩy dữ liệu excel lên google sheet

• blackmango
• Dec 10, 2024
• Lập trình / CNTT

Replies 0 Views 542 Dec 10, 2024 blackmango kiến thức [Excel VBA] Xử lý bất đồng bộ khi làm việc với cơ sở dữ liệu

• NguyenDang95
• May 26, 2024
• Phần mềm

Replies 2 Views 1K Jul 11, 2024 Phú hà 94 kiến thức [Excel VBA] Làm việc với SharePoint List

• NguyenDang95
• May 24, 2023
• Phần mềm

Replies 2 Views 2K Jun 2, 2023 Louisnghia kiến thức [Outlook VBA] Tự động gửi email trả lời kèm theo dữ liệu theo yêu cầu

• NguyenDang95
• Nov 1, 2022
• Phần mềm

Replies 0 Views 2K Nov 1, 2022 NguyenDang95 kiến thức [Excel VBA] Sử dụng biểu thức chính quy (Regular Expression) để trích xuất văn bản

• NguyenDang95
• Oct 31, 2022
• Phần mềm

Replies 0 Views 2K Oct 31, 2022 NguyenDang95 Share: Facebook X (Twitter) LinkedIn Reddit Pinterest WhatsApp Share Link

Thread statistics

Created NguyenDang95, Dec 14, 2021 Last reply from Khoahuynh22111990, Dec 24, 2021 Replies 27 Views 4,296

Share this page

Facebook X (Twitter) LinkedIn Reddit Pinterest WhatsApp Share Link

• Forums
• Phần mềm & Games
• Phần mềm

Back Top