Chuẩn hoá định dạng email có đuôi gmail.com (1 người xem)

Liên hệ QC

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

8589934592

Thành viên mới
Tham gia
14/3/12
Bài viết
7
Được thích
1
Mình đang có một danh sách email chưa được chuẩn hoá định dạng email (xem trong file đính kèm). Trong file mình đã mô tả lỗi cụ thể của từng email.
Các bạn giúp mình lập một Function trong VBA để giải quyết bài toán chuẩn hoá này.
Xin cảm ơn các bạn đã giúp đỡ.
 

File đính kèm

Mình đang có một danh sách email chưa được chuẩn hoá định dạng email (xem trong file đính kèm). Trong file mình đã mô tả lỗi cụ thể của từng email.
Các bạn giúp mình lập một Function trong VBA để giải quyết bài toán chuẩn hoá này.
Xin cảm ơn các bạn đã giúp đỡ.
Chờ mod dời bài đúng box và hóng giải thuật.
 
Các trường hợp được coi là lỗi và đã xử lý trong code:
  1. Chứa ký tự không hợp lệ
  2. Nhiều dấu chấm liên tiếp
  3. Thiếu @
  4. Đảo 2 ký tự trong tên miền
  5. Sai 1 ký tự trong tên miền
  6. Thiếu 1 ký tự trong tên miền
  7. Tên miền dư .xx
Mã:
Option Compare Text
Function ChuanHoaEmail(ByVal sDiaChiMail As String, Optional ByVal sTenMien As String = "@gmail.com", Optional ByVal sKyTuKhongHopLe As String = " /\<>&=-',<>") As String
Dim i As Long, sLoi As String
sDiaChiMail = Replace(sDiaChiMail, " ", "")
For i = 1 To Len(sKyTuKhongHopLe)
    sDiaChiMail = Replace(sDiaChiMail, Mid(sKyTuKhongHopLe, i, 1), "")
Next
'xoa ..
While InStr(sDiaChiMail, "..") > 0
    sDiaChiMail = Replace(sDiaChiMail, "..", ".")
Wend
i = InStrRev(sDiaChiMail, "@")
If i = 0 Then
    'Thieu @
    If KiemTra(sDiaChiMail, sTenMien, Mid(sTenMien, 2)) Then GoTo KetQua
Else
    'Xoa @ khong hop le
    sDiaChiMail = Replace(Left(sDiaChiMail, i - 1), "@", "") & Mid(sDiaChiMail, i)
End If
For i = 2 To Len(sTenMien)
    'Dao ky tu
    sLoi = sTenMien
    Mid(sLoi, i, 2) = VBA.StrReverse(Mid(sLoi, i, 2))
    If KiemTra(sDiaChiMail, sTenMien, sLoi) Then GoTo KetQua
    'Sai 1 ky tu
    sLoi = sTenMien
    Mid(sLoi, i, 1) = "?"
    If KiemTra(sDiaChiMail, sTenMien, sLoi) Then GoTo KetQua
    'Thieu 1 ky tu
    sLoi = Left(sTenMien, i - 1) & Mid(sTenMien, i + 1)
    If KiemTra(sDiaChiMail, sTenMien, sLoi) Then GoTo KetQua
Next
'Du duoi .xx
If sDiaChiMail Like "*" & sTenMien & ".*" Then
    sDiaChiMail = Left(sDiaChiMail, InStr(sDiaChiMail, sTenMien) - 1) & sTenMien
End If
KetQua:
ChuanHoaEmail = sDiaChiMail
End Function
Private Function KiemTra(ByRef sDiaChiMail As String, ByRef sTenMien As String, ByVal sLoi As String) As Boolean
    If sDiaChiMail Like "*" & sLoi Then
        sDiaChiMail = Left(sDiaChiMail, Len(sDiaChiMail) - Len(sLoi)) & sTenMien
        KiemTra = True
    End If
End Function
 
Web KT

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

Back
Top Bottom