ABC自动生成

wscript.echo "自动生成 Abcbar 程序 By 72hour！"
olFolderContacts = 10
olContact = 40
Set myOlApp = CreateObject("Outlook.Application")
Set myNamespace = myOlApp.GetNamespace("MAPI")
Set myContacts = myNamespace.GetDefaultFolder(olFolderContacts).Items
Set myFSO = CreateObject("Scripting.FileSystemObject")   
Set WshShell = WScript.CreateObject("WScript.Shell")
For Each myItem In myContacts
kk=kk+LCase(CStr(myItem.FullName))
Next
function pinyin(str)
tmpp=65536+asc(str)
if(tmpp>=45217 and tmpp<=45252) then
pinyin= "A"
elseif(tmpp>=45253 and tmpp<=45760) then
pinyin= "B"
elseif(tmpp>=45761 and tmpp<=46317) then
pinyin= "C"
elseif(tmpp>=46318 and tmpp<=46825) then
pinyin= "D"
elseif(tmpp>=46826 and tmpp<=47009) then
pinyin= "E"
elseif(tmpp>=47010 and tmpp<=47296) then
pinyin= "F"
elseif(tmpp>=47297 and tmpp<=47613) then
pinyin= "G"
elseif(tmpp>=47614 and tmpp<=48118) then
pinyin= "H"
elseif(tmpp>=48119 and tmpp<=49061) then
pinyin= "J"
elseif(tmpp>=49062 and tmpp<=49323) then
pinyin= "K"
elseif(tmpp>=49324 and tmpp<=49895) then
pinyin= "L"
elseif(tmpp>=49896 and tmpp<=50370) then
pinyin= "M"
elseif(tmpp>=50371 and tmpp<=50613) then
pinyin= "N"
elseif(tmpp>=50614 and tmpp<=50621) then
pinyin= "O"
elseif(tmpp>=50622 and tmpp<=50905) then
pinyin= "P"
elseif(tmpp>=50906 and tmpp<=51386) then
pinyin= "Q"
elseif(tmpp>=51387 and tmpp<=51445) then
pinyin= "R"
elseif(tmpp>=51446 and tmpp<=52217) then
pinyin= "S"
elseif(tmpp>=52218 and tmpp<=52697) then
pinyin= "T"
elseif(tmpp>=52698 and tmpp<=52979) then
pinyin= "W"
elseif(tmpp>=52980 and tmpp<=53640) then
pinyin= "X"
elseif(tmpp>=53689 and tmpp<=54480) then
pinyin= "Y"
elseif(tmpp>=54481 and tmpp<=62289) then
pinyin= "Z"
end if
end function
Function RegExpTest(patrn, strng)
  Dim regEx, retVal            ' Create variable.
  Set regEx = New RegExp         ' Create regular e-xpression.
  regEx.Pattern = patrn         ' Set pattern.
  regEx.IgnoreCase = True      ' Set case insensitivity.
  RegExpTest = regEx.Test(strng)      ' Execute the search test.
End Function
strlen = Len(CStr(kk))
For x = 1 to strlen step 1
    Clet = Mid(CStr(kk),x,1)
If Clet<>" " And Not RegExpTest("[A-Za-z]",Clet) Then
if not instr(ll,clet)>0 then
ll=ll+clet
end if
end if
next
strlen1 = Len(CStr(ll))
For xx = 1 to strlen1
    Clet1 = Mid(CStr(ll),xx,1)
select case pinyin(Clet1)
case "A"
a1=a1+Clet1
case "B"
B1=B1+Clet1
case "C"
C1=C1+Clet1
case "D"
D1=D1+Clet1
case "E"
E1=E1+Clet1
case "F"
F1=F1+Clet1
case "G"
G1=G1+Clet1
case "H"
qqq=qqq+Clet1
case "I"
I1=I1+Clet1
case "J"
J1=J1+Clet1
case "K"
K1=K1+Clet1
case "L"
L1=L1+Clet1
case "M"
M1=M1+Clet1
case "N"
N1=N1+Clet1
case "O"
aaa=aaa+Clet1
case "P"
P1=P1+Clet1
case "Q"
Q1=Q1+Clet1
case "R"
R1=R1+Clet1
case "S"
S1=S1+Clet1
case "T"
T1=T1+Clet1
case "U"
U1=U1+Clet1
case "V"
V1=V1+Clet1
case "W"
W1=W1+Clet1
case "X"
X1=X1+Clet1
case "Y"
Y1=Y1+Clet1
case "Z"
Z1=Z1+Clet1
end select
    Next
wancheng="ABC/ABCabc"&A1&B1&C1&" "+"DEF/DEFdef"&D1&E1&F1&" "+"GHI/GHIghi"&G1&qqq&I1&" "+"JKL/JKLjkl"&J1&K1&L1&" "+"MNO/MNOmno"&M1&N1&aaa&" "+"PQRS/PQRSpqrs"&P1&Q1&R1&S1&" "+"TUV/TUVtuv"&T1&U1&V1&" "+"WXYZ/WXYZwxyz"&W1&X1&Y1&Z1&" "
objWorkingFolder = WshShell.CurrentDirectory
Set fout = myFSO.CreateTextFile(objWorkingFolder&"\\AbcBar.txt", true)
fout.Write wancheng
fout.Close()
wscript.echo "操作已完成！"