|
Excel 中的宏代码： Type tele
FILnAME As String * 11
tn As String * 11
dn As String * 7
sett As String * 5
code As String * 6
color As String * 2
rls As String * 2
part As String * 8
cden As String * 5
marp As String * 4
phntm As String * 10
bar As String * 3
zone As String * 3
wrls As String * 3
ncos As String * 2
rnpg As String * 4
hunt As String * 16
eht As String * 16
fdn As String * 16
efd As String * 16
dest As String * 16
rtda As String * 4
arto As String * 2
ahnt As String * 16
aeht As String * 16
afd As String * 16
aefd As String * 16
cust As String * 2
ten As String * 2
tgar As String * 2
sgrp As String * 2
scpw As String * 7
note As String * 16
des As String * 7
aom As String * 1
fna As String * 1
cfta As String * 1
fba As String * 1
hta As String * 1
hbta As String * 1
scc As String * 4
ssc As String * 4
cont As String * 1
xlst As String * 1
disp As String * 1
drg As String * 1
ddi As String * 1
mwa As String * 1
cfxa As String * 1
mta As String * 1
sfa As String * 1
rco As String * 1
sci As String * 1
plev As String * 1
dcfw As String * 20
icf As String * 1
xfa As String * 1
c6a As String * 1
tsa As String * 1
xra As String * 1
wta As String * 1
usra As String * 1
phd As String * 1
lna As String * 1
rdl As String * 1
cfw As String * 1
mnl As String * 1
cwa As String * 1
lpa As String * 1
icda As String * 1
ovda As String * 1
ccsa As String * 1
cnda As String * 1
agt As String * 3
aha As String * 1
aaa As String * 1
arha As String * 1
aos As String * 1
hfa As String * 1
ira As String * 1
hpr As String * 1
DTN As String * 1
PYA As String * 1
nama As String * 1
nia As String * 1
ola As String * 1
poa As String * 1
swa As String * 1
xha As String * 1
dgr As String * 1
kba As String * 1
dba As String * 1
flx As String * 1
sts As String * 1
crp As String * 1
grl As String * 1
lhk As String * 2
ast As String * 6
iapg As String * 2
key(0 To 75) As String * 26
nam As String * 30
acct As String * 8
dept As String * 30
locn As String * 25
USER As String * 20
HOT As String * 20
QU As String * 10
POSID As String * 10
aacs As String * 3
acq As String * 15
asid As String * 3
sfnb As String * 4
sfnbn As String * 70
sfrb As String * 4
sfrbn As String * 70
usfb As String * 4
usfbn As String * 70
itna As String * 3
Datt As String * 12 End Type Type ser
code As String * 6
color As String * 2
rls As String * 2
part As String * 8
Tnn As String * 11
End Type Global file
Global tele As tele
Global cleartele As tele
Global CO
Global a
Global sht
Global wkbkname Global DDI_NUMBER
Global CO_NAME Global dnstart As Integer
Global dnlength As Integer
Global ccstart As Integer
Global cclength As Integer
Global locnstart As Integer
Global locnlength As Integer
Global userstart As Integer
Global userlength As Integer
Global deptstart As Integer
Global deptlength As Integer
Global maildn
Global MDIR As Long
Global ODIR As Long
Global BBH As Integer
Global BBV As Integer
Global BSV As Integer Function OpenFile() As String
file = Application.GetOpenFilename("Text Files (*.*), *.txt, All Files (*.*), *.txt")
Open file For Input As #1
'PickFileName (File) OpenFile = file
End Function
Function PickFileName(file As String) As String
Dim pointer As Integer While (InStr(file, "\"))
pointer = InStr(file, "\")
file = Mid(file, pointer + 1)
Wend While (InStr(file, "."))
pointer = InStr(file, ".")
file = Mid(file, 1, pointer - 1)
Wend sht = file
PickFileName = file
End Function
Sub Auto_Open()
UserForm1.Show
End Sub Sub main()
Dim MyData As DataObject Dim tele As tele
'ReDim q(200) As String
Dim ser(6000) As ser wkbkname = ActiveWorkbook.Name pathandfile = OpenFile PickFileName (pathandfile) ' User did not put in a filename so just quit
'If PathandFile = False Then Exit Sub
' Make sure the filename can be found (Unlikely that it cannot)
If Dir(pathandfile) = "" Then
MsgBox "Could not open file"
Exit Sub
End If a = 1
emtyname = tele.nam
gotser = False 'Not Option 11
While Not EOF(1)
Line Input #1, za
If Mid(za, 5, 1) = "," Then
If Mid(za, 20, 1) <> "<" Then
gotser = True
ser(a).Tnn = Mid(za, 7, 11)
ser(a).code = Mid(za, 46, 6)
ser(a).color = Mid(za, 40, 2)
ser(a).rls = Mid(za, 43, 2)
ser(a).part = Mid(za, 31, 8)
a = a + 1
End If
End If
Wend
Reset 'Option 11
Open file For Input As #1
While Not EOF(1)
Line Input #1, za
If Mid(za, 5, 1) = "," Then
If Mid(za, 12, 1) = "," Then
gotser = True
ser(a).Tnn = "0" & Mid(za, 7, 2) & " 0 00 " & Mid(za, 10, 2)
ser(a).code = Mid(za, 40, 6)
ser(a).color = Mid(za, 34, 2)
ser(a).rls = Mid(za, 37, 2)
ser(a).part = Mid(za, 25, 8)
a = a + 1
End If
End If
Wend
Reset
Open file For Input As #1
tempkey = 99
rec = 0
Open "c:\TEMP.PRN" For Output As #2
a = Chr(34)
b = Chr(9)
' Chr(44) & Chr(34)
For t = 0 To 75
keyy = keyy & a & "Key" & Str(t) & a & b
Next t
keyy = keyy & a
Print #2, a & "TN" & a & b;
Print #2, a & "DN" & a & b;
Print #2, a & "MARP" & a & b;
Print #2, a & "TYPE" & a & b;
If gotser = True Then
Print #2, a & "PART#" & a & b;
Print #2, a & "COLOR" & a & b;
Print #2, a & "RLS" & a & b;
Print #2, a & "SERIAL#" & a & b;
End If
Print #2, a & "PHNTM" & a & b;
Print #2, a & "WRLS" & a & b;
Print #2, a & "CDEN" & a & b;
Print #2, a & "ZONE" & a & b;
Print #2, a & "NAME" & a & b;
Print #2, a & "QUEUE" & a & b;
Print #2, a & "POSID" & a & b;
Print #2, a & "DCFW" & a & b;
Print #2, a & "CFW Dest" & a & b;
Print #2, a & "Notes" & a & b;
Print #2, a & "CLS" & a & b;
Print #2, a & "NCOS" & a & b;
Print #2, a & "RNPG" & a & b;
Print #2, a & "HUNT" & a & b;
Print #2, a & "EHT" & a & b;
Print #2, a & "FDN" & a & b;
Print #2, a & "EFD" & a & b;
Print #2, a & "RTDA" & a & b;
Print #2, a & "ARTO" & a & b;
Print #2, a & "AHNT" & a & b;
Print #2, a & "AEHT" & a & b;
Print #2, a & "AFD" & a & b;
Print #2, a & "AEFD" & a & b;
Print #2, a & "CUST" & a & b;
Print #2, a & "TEN" & a & b;
Print #2, a & "TGAR" & a & b;
Print #2, a & "SGRP" & a & b;
Print #2, a & "SCPW" & a & b;
Print #2, a & "DES" & a & b;
Print #2, a & "AOM" & a & b;
Print #2, a & "FNA" & a & b;
Print #2, a & "CFTA" & a & b;
Print #2, a & "FBA" & a & b;
Print #2, a & "HTA" & a & b;
Print #2, a & "HBTA" & a & b;
Print #2, a & "SCC" & a & b;
Print #2, a & "DDI" & a & b;
Print #2, a & "MWA" & a & b;
Print #2, a & "CFXA" & a & b;
Print #2, a & "MTA" & a & b;
Print #2, a & "SFA" & a & b;
Print #2, a & "XLST" & a & b;
Print #2, a & "AST" & a & b;
Print #2, a & "IAPG" & a & b; If UserForm1.CheckBox2.Value Then
Print #2, a & "aaa" & a & b;
Print #2, a & "acct" & a & b;
Print #2, a & "agt" & a & b;
Print #2, a & "aha" & a & b;
Print #2, a & "aos" & a & b;
Print #2, a & "arha" & a & b;
Print #2, a & "c6a" & a & b;
Print #2, a & "ccsa" & a & b;
Print #2, a & "cfw" & a & b;
Print #2, a & "cnda" & a & b;
Print #2, a & "cwa" & a & b;
Print #2, a & "dgr" & a & b;
Print #2, a & "disp" & a & b;
Print #2, a & "hfa" & a & b;
Print #2, a & "hpr" & a & b;
Print #2, a & "icda" & a & b;
Print #2, a & "icf" & a & b;
Print #2, a & "ira" & a & b;
Print #2, a & "lna" & a & b;
Print #2, a & "lpa" & a & b;
Print #2, a & "mnl" & a & b;
Print #2, a & "nama" & a & b;
Print #2, a & "nia" & a & b;
Print #2, a & "ola" & a & b;
Print #2, a & "ovda" & a & b;
Print #2, a & "phd" & a & b;
Print #2, a & "plev" & a & b;
Print #2, a & "poa" & a & b;
Print #2, a & "rco" & a & b;
Print #2, a & "rdl" & a & b;
Print #2, a & "sci" & a & b;
Print #2, a & "swa" & a & b;
Print #2, a & "tsa" & a & b;
End If
Print #2, a & "usra" & a & b; If UserForm1.CheckBox2.Value Then
Print #2, a & "wta" & a & b;
Print #2, a & "xfa" & a & b;
Print #2, a & "xha" & a & b;
Print #2, a & "xra" & a & b;
Print #2, a & "KBA" & a & b;
Print #2, a & "DBA" & a & b;
Print #2, a & "FLX" & a & b;
Print #2, a & "STS" & a & b;
Print #2, a & "CRP" & a & b;
Print #2, a & "GRL" & a & b;
Print #2, a & "DRG" & a & b;
End If If UserForm1.CheckBox3.Value Then
Print #2, a & "AACS" & a & b;
Print #2, a & "ACQ" & a & b;
Print #2, a & "ASID" & a & b;
Print #2, a & "SFNB" & a & b;
Print #2, a & "SFNB STR" & a & b;
Print #2, a & "SFRB" & a & b;
Print #2, a & "SFRB STR" & a & b;
Print #2, a & "USFB" & a & b;
Print #2, a & "USFB STR" & a & b;
Print #2, a & "ITNA" & a & b;
End If
Print #2, a & "LHK" & a & b;
If UserForm1.CheckBox1.Value Then
For ff = 0 To 75
Print #2, a & "KEY " & ff & a & b;
Next ff
End If
Print #2, a & "HOT LINE" & a & b;
Print #2, a & "DATE" & a
'Open PathandFile For Input As #1
tele.dn = "unknown"
While Not EOF(1)
Line Input #1, za
If InStr(1, za, Chr(34)) Then Mid(za, (InStr(1, za, Chr(34)))) = " "
If InStr(1, za, Chr(34)) Then Mid(za, (InStr(1, za, Chr(34)))) = " "
If InStr(1, za, Chr(34)) Then Mid(za, (InStr(1, za, Chr(34)))) = " "
If InStr(1, za, Chr(34)) Then Mid(za, (InStr(1, za, Chr(34)))) = " "
If InStr(1, za, Chr(34)) Then Mid(za, (InStr(1, za, Chr(34)))) = " "
If InStr(1, za, Chr(10)) Then Mid(za, (InStr(1, za, Chr(10)))) = " " If UCase(Left$(za, 4)) = "DATE" Then tele.Datt = Mid$(za, 6, Len(za)) If UCase(Left$(za, 4)) <> "DATE" Then
If Left$(za, 4) = "CUST" Then tele.cust = Mid$(za, 6, Len(za))
If Left$(za, 3) = "DN " Then
tele.dn = Mid$(za, 6, Len(za))
If InStr(1, za, "MARP") Then tele.marp = "MARP"
End If
If Left$(za, 3) = "TN " Then
tele.tn = Mid$(za, 6, Len(za))
tele.phntm = " "
tele.phntm = Mid$(za, 19, 29)
End If
If Left$(za, 10) = "KEY 00 SC" Then
tele.dn = Mid$(za, 13, Len(za))
If InStr(1, za, "MARP") Then tele.marp = "MARP"
End If
If Left$(za, 3) = "TYP" Then tele.sett = Mid$(za, 6, Len(za))
If Left$(za, 4) = "CDEN" Then tele.cden = Mid$(za, 6, Len(za))
If Left$(za, 4) = "WRLS" Then tele.wrls = Mid$(za, 6, Len(za))
If Left$(za, 4) = "HUNT" Then tele.hunt = Mid$(za, 6, Len(za))
If Left$(za, 4) = "RCO " Then tele.rco = Mid$(za, 6, Len(za))
If Left$(za, 4) = "AST " Then tele.ast = Mid$(za, 6, Len(za))
If Left$(za, 4) = "IAPG" Then tele.iapg = Mid$(za, 6, Len(za))
If Left$(za, 4) = "ZONE" Then tele.zone = Mid$(za, 6, Len(za))
If Left$(za, 4) = "AACS" Then tele.aacs = Mid$(za, 6, Len(za))
If Left$(za, 4) = "ACQ " Then tele.acq = Mid$(za, 6, Len(za))
If Left$(za, 4) = "ASID" Then tele.asid = Mid$(za, 6, Len(za))
If Left$(za, 4) = "SFNB" Then
tele.sfnb = "SFNB"
tele.sfnbn = Mid$(za, 6, Len(za))
End If
If Left$(za, 4) = "SFRB" Then
tele.sfrb = "SFRB"
tele.sfrbn = Mid$(za, 6, Len(za))
End If
If Left$(za, 4) = "USFB" Then
tele.usfb = "USFB"
tele.usfbn = Mid$(za, 6, Len(za))
End If
If Left$(za, 4) = "ITNA" Then tele.itna = Mid$(za, 6, Len(za))
If Left$(za, 4) = "TGAR" Then tele.tgar = Mid$(za, 6, Len(za))
If Left(za, 11) = " NAME" Then
If Val(tele.sett) = 500 Then tele.nam = Mid(za, 13, 24)
End If
If Left(za, 13) = " NAME" Then
If Val(tele.sett) = 500 Then tele.nam = Mid(za, 15, 24)
End If
If Left$(za, 4) = "NCOS" Then tele.ncos = Mid$(za, 6, Len(za))
If Left$(za, 3) = "SSU" Then tele.ssc = Mid$(za, 6, Len(za))
If Left$(za, 8) = "FTR SSU" Then tele.ssc = Mid$(za, 10, Len(za))
If Left$(za, 8) = "FTR SSU" Then tele.ssc = Mid$(za, 10, Len(za))
If Left$(za, 8) = "FTR SCU" Then
tele.scc = Mid$(za, 10, Len(za))
tele.cont = "U"
End If
If Left$(za, 8) = "FTR SCC" Then
tele.scc = Mid$(za, 10, Len(za))
tele.cont = "C"
End If
If Left$(za, 4) = "RNPG" Then tele.rnpg = Mid$(za, 6, Len(za))
If Left$(za, 9) = "FTR AHNT" Then tele.ahnt = Mid$(za, 10, Len(za))
If Left$(za, 4) = "AHNT" Then tele.ahnt = Mid$(za, 6, Len(za))
If Left$(za, 9) = "FTR AEHT" Then tele.aeht = Mid$(za, 10, Len(za))
If Left$(za, 4) = "AEHT" Then tele.aeht = Mid$(za, 6, Len(za))
If Left$(za, 8) = "FTR AFD" Then tele.afd = Mid$(za, 10, Len(za))
If Left$(za, 4) = "AFD " Then tele.afd = Mid$(za, 6, Len(za))
If Left$(za, 8) = "FTR ACD" Then
secc = InStr(11, za, " ")
tele.QU = Mid$(za, 10, secc - 10)
tele.POSID = Mid$(za, secc + 1, 99)
End If
If Mid$(za, 6, 6) = "00 ACD" Then
secc = InStr(13, za, " ") + 1
tele.QU = Mid$(za, 13, secc - 13)
tele.POSID = Mid$(za, secc + 1, 99)
End If
If Left$(za, 9) = "FTR AEFD" Then tele.aefd = Mid$(za, 10, Len(za))
If Left$(za, 4) = "AEFD" Then tele.aefd = Mid$(za, 6, Len(za))
If Left$(za, 8) = "FTR FDN" Then tele.fdn = Mid$(za, 10, Len(za))
If Left$(za, 4) = "FDN " Then tele.fdn = Mid$(za, 6, Len(za))
If Left$(za, 8) = "FTR EHT" Then tele.eht = Mid$(za, 10, Len(za))
If Left$(za, 4) = "EHT " Then tele.eht = Mid$(za, 6, Len(za))
If Left$(za, 8) = "FTR EFD" Then tele.efd = Mid$(za, 10, Len(za))
If Left$(za, 4) = "EFD " Then tele.efd = Mid$(za, 6, Len(za))
If Left$(za, 3) = "DES" Then tele.des = Mid$(za, 6, Len(za))
If InStr(1, za, " UNR ") > 2 Then tele.bar = "UNR "
If InStr(1, za, " CTD ") > 2 Then tele.bar = "CTD"
If InStr(1, za, " CUN ") > 2 Then tele.bar = "CUN"
If InStr(1, za, " FR1 ") > 2 Then tele.bar = "FR1"
If InStr(1, za, " FR2 ") > 2 Then tele.bar = "FR2"
If InStr(1, za, " FRE ") > 2 Then tele.bar = "FRE"
If InStr(1, za, " SRE ") > 2 Then tele.bar = "SRE"
If InStr(1, za, " TLD ") > 2 Then tele.bar = "TLD"
If Left$(za, 8) = "FTR HOT" Then tele.HOT = Mid$(za, 11, Len(za))
If InStr(1, za, " ADD") > 2 Then tele.disp = "T"
If InStr(1, za, " DDS") > 2 Then tele.disp = "T"
If InStr(1, za, " NDD") > 2 Then tele.disp = "F"
If Trim(tele.nam) = emtyname Then
If Left$(za, 14) = " NAME" Then tele.nam = Mid(za, 16, 24)
If Left$(za, 16) = " NAME" Then tele.nam = Mid(za, 16, 24) End If
' now the keys
If Len(za) = 17 Then
If Mid(za, 9, 1) = " " Then
If Mid(za, 11, 1) = " " Then
If Mid(za, 14, 1) = " " Then
itsatn = True
End If
End If
End If
End If If itsatn <> True Then
If Left$(za, 5) = "KEY " Or Left$(za, 5) = " " And Val(Mid$(za, 6, 2)) >= 1 And Val(Mid$(za, 6, 1)) < 75 And InStr(za, 1) <> "AGN" And InStr(za, 1) <> "SPV" Then
tele.key(Val(Mid$(za, 6, 2))) = Mid$(za, 9, Len(za))
tempkey = Val(Mid$(za, 6, 2)) End If
End If
itsatn = False 'CLS ------------------------------------------------------------
If Left$(za, 3) = "TEN" Then tele.ten = Mid$(za, 6, Len(za))
If Left$(za, 3) = "SCI" Then tele.sci = Mid$(za, 6, Len(za))
If Left$(za, 4) = "PLEV" Then tele.plev = Mid$(za, 6, Len(za))
If Left$(za, 4) = "SCPW" Then tele.scpw = Mid$(za, 6, Len(za))
If Left$(za, 4) = "ARTO" Then tele.arto = Mid$(za, 6, Len(za))
If Left$(za, 4) = "XLST" Then tele.xlst = Mid$(za, 6, Len(za))
If Left$(za, 9) = "FTR DCFW" Then tele.dcfw = Trim(Mid$(za, 14, Len(za)))
If Left$(za, 8) = "FTR ICF" Then tele.icf = Mid$(za, (Len(za) - 6), Len(za))
If InStr(1, za, " UDI") > 2 Then tele.ddi = "Y"
If InStr(1, za, " XFA") > 2 Then tele.xfa = "A"
If InStr(1, za, " C6A") > 2 Then tele.c6a = "A"
If InStr(1, za, " TSA") > 2 Then tele.tsa = "A"
If InStr(1, za, " XRA") > 2 Then tele.xra = "A"
If InStr(1, za, " KBA") > 2 Then tele.kba = "A"
If InStr(1, za, " DBA") > 2 Then tele.dba = "A"
If InStr(1, za, " FLXA") > 2 Then tele.flx = "A"
If InStr(1, za, " STSA") > 2 Then tele.sts = "A"
If InStr(1, za, " CRPA") > 2 Then tele.crp = "A"
If InStr(1, za, " GRLA") > 2 Then tele.grl = "A"
If InStr(1, za, " KBD") > 2 Then tele.kba = "D"
If InStr(1, za, " DBD") > 2 Then tele.dba = "D"
If InStr(1, za, " FLXD") > 2 Then tele.flx = "D"
If InStr(1, za, " STSD") > 2 Then tele.sts = "D"
If InStr(1, za, " CRPD") > 2 Then tele.crp = "D"
If InStr(1, za, " GRLD") > 2 Then tele.grl = "D"
If InStr(1, za, " WTA") > 2 Then tele.wta = "A"
If InStr(1, za, " MWA") > 2 Then tele.mwa = "A"
If InStr(1, za, " USRA") > 2 Then tele.usra = "A"
If Left$(za, 8) = "FTR PHD" Then tele.phd = "Y"
If InStr(1, za, " LNA") > 2 Then tele.lna = "A"
If Left$(za, 8) = "FTR RDL" Then tele.rdl = "Y"
If Left$(za, 8) = "FTR CFW" Then
tele.cfw = "Y"
tele.dest = Trim(Mid$(za, 12, Len(za)))
End If
If InStr(1, za, " MNL") > 2 Then tele.mnl = "Y"
If InStr(1, za, " CWA") > 2 Then tele.cwa = "A"
If InStr(1, za, " LPA") > 2 Then tele.lpa = "A"
If InStr(1, za, " CFXA") > 2 Then tele.cfxa = "A"
If InStr(1, za, " ICDA") > 2 Then tele.icda = "A"
If InStr(1, za, " RTDA") > 2 Then tele.rtda = "RTDA"
If InStr(1, za, " OVDA") > 2 Then tele.ovda = "A"
If InStr(1, za, " SFA") > 2 Then tele.sfa = "A"
If Left$(za, 3) = "RCO" Then tele.rco = Mid$(za, 6, Len(za))
If InStr(1, za, " CCSA") > 2 Then tele.ccsa = "A"
If InStr(1, za, " CNDA") > 2 Then tele.cnda = "A"
If InStr(1, za, " AGN") > 2 Then tele.agt = "AGT"
If InStr(1, za, " SUPY") > 2 Then tele.agt = "AGT"
If InStr(1, za, " SPV") > 2 Then tele.agt = "SPV"
If InStr(1, za, " AHA") > 2 Then tele.aha = "Y"
If InStr(1, za, " LNA") > 2 Then tele.lna = "A"
If Left$(za, 3) = "AOM" Then tele.aom = Mid$(za, 6, Len(za))
If InStr(1, za, " AAA") > 2 Then tele.aaa = "A"
If InStr(1, za, " ARHA") > 2 Then arah = "A"
If InStr(1, za, " AOS") > 2 Then tele.aos = "Y"
If InStr(1, za, " HFA") > 2 Then tele.hfa = "A"
If InStr(1, za, " IRA") > 2 Then tele.ira = "A"
If InStr(1, za, " HPR") > 2 Then tele.hpr = "Y"
If InStr(1, za, " MTA") > 2 Then tele.mta = "A"
If InStr(1, za, " NAMA") > 2 Then tele.nama = "A"
If InStr(1, za, " NIA") > 2 Then tele.nia = "A"
If InStr(1, za, " OLA") > 2 Then tele.ola = "A"
If InStr(1, za, " POA") > 2 Then tele.poa = "A"
If InStr(1, za, " SWA") > 2 Then tele.swa = "A"
If InStr(1, za, " XHA") > 2 Then tele.xha = "A"
If InStr(1, za, " DRG1") > 3 Then tele.drg = "1"
If InStr(1, za, " DRG2") > 3 Then tele.drg = "2"
If InStr(1, za, " DRG3") > 3 Then tele.drg = "3"
If InStr(1, za, " DRG4") > 3 Then tele.drg = "4"
If Left$(za, 4) = "SGRP" Then tele.sgrp = Mid$(za, 6, Len(za))
If Left$(za, 3) = "LHK" Then tele.lhk = Mid$(za, 6, Len(za))
If InStr(1, za, " FNA") > 2 Then tele.fna = "A"
If InStr(1, za, " CFTA") > 2 Then tele.cfta = "A"
If InStr(1, za, " FBA") > 2 Then tele.fba = "A"
If InStr(1, za, " HTA") > 2 Then tele.hta = "A"
If InStr(1, za, " HBTA") > 2 Then tele.hbta = "A"
Else If tele.dn = "unknown" Then For I = 0 To 15 If tele.dn = "unknown" And Left$(tele.key(I), 3) = "SCR" Then
tele.dn = Mid$(tele.key(I), 5, 7)
If InStr(1, tele.key(I), "MARP") Then tele.marp = "MARP"
End If If tele.dn = "unknown" And Left$(tele.key(I), 3) = "SCN" Then
tele.dn = Mid$(tele.key(I), 5, 7)
If InStr(1, tele.key(I), "MARP") Then tele.marp = "MARP"
End If If InStr(1, tele.dn, "MARP") Then
tele.dn = Left(tele.dn, InStr(1, tele.dn, "MARP") - 1)
tele.marp = "MARP"
End If If Right(tele.dn, 2) = " 0" Then tele.dn = Left(tele.dn, Len(tele.dn) - 2)
Next I For I = 0 To 15
If tele.dn = "unknown" And Left$(tele.key(I), 3) = "MCR" Then tele.dn = Mid$(tele.key(I), 5, 7)
If tele.dn = "unknown" And Left$(tele.key(I), 3) = "MCN" Then tele.dn = Mid$(tele.key(I), 5, 7)
If InStr(1, tele.dn, "MARP") Then tele.dn = Left(tele.dn, InStr(1, tele.dn, "MARP") - 1)
If Right(tele.dn, 2) = " 0" Then tele.dn = Left(tele.dn, Len(tele.dn) - 2)
Next I End If
DoEvents
If tele.ncos <> "" Then
'xxxxxxxx
gotit = False
If UserForm1.CheckBox4.Value Then gotit = True
If InStr(1, Trim(tele.sett), "500") > 0 Or Trim(tele.sett) = "2006" Or Trim(tele.sett) = "2008" Or Trim(tele.sett) = "2616" Or Trim(tele.sett) = "2216" Or InStr(1, Trim(tele.sett), "SL1") > 0 Or InStr(1, Trim(tele.sett), "390") > 0 Or InStr(1, Trim(tele.sett), "I20") > 0 Or Trim(tele.sett) = "2317" Or Trim(tele.sett) = "2009" Or Trim(tele.sett) = "2112" Or Trim(tele.sett) = "2018" Then gotit = True
'for all TN's, uncomment line below and comment the line above
'If Trim(tele.sett) <> "" Then
If gotit Then
If InStr(1, tele.dn, "MARP") Then tele.dn = Left(tele.dn, InStr(1, tele.dn, "MARP") - 1)
If Trim(tele.sett) = "2006" Then
t2006 = t2006 + 1
Range("C11").Select
ActiveCell.FormulaR1C1 = t2006
End If
If Trim(tele.sett) = "2008" Then
t2008 = t2008 + 1
Range("C12").Select
ActiveCell.FormulaR1C1 = t2008
End If
If Trim(tele.sett) = "2616" Then
t2616 = t2616 + 1
Range("C13").Select
ActiveCell.FormulaR1C1 = t2616
End If
If Trim(tele.sett) = "2009" Then
t2009 = t2009 + 1
Range("C16").Select
ActiveCell.FormulaR1C1 = t2009
End If
If Trim(tele.sett) = "2112" Then
t2112 = t2112 + 1
Range("C17").Select
ActiveCell.FormulaR1C1 = t2112
End If
If Trim(tele.sett) = "2018" Then
t2018 = t2018 + 1
Range("C19").Select
ActiveCell.FormulaR1C1 = t2018
End If
If Trim(tele.sett) = "3901" Then
t3901 = t3901 + 1
Range("C20").Select
ActiveCell.FormulaR1C1 = t3901
End If
If Trim(tele.sett) = "3902" Then
t3902 = t3902 + 1
Range("C21").Select
ActiveCell.FormulaR1C1 = t3902
End If
If Trim(tele.sett) = "3903" Then
t3903 = t3903 + 1
Range("C22").Select
ActiveCell.FormulaR1C1 = t3903
End If
If Trim(tele.sett) = "3904" Then
t3904 = t3904 + 1
Range("C23").Select
ActiveCell.FormulaR1C1 = t3904
End If
If Trim(tele.sett) = "3905" Then
t3905 = t3905 + 1
Range("C24").Select
ActiveCell.FormulaR1C1 = t3905
End If
If Trim(tele.sett) = "3903H" Then
t3903H = t3903H + 1
Range("C25").Select
ActiveCell.FormulaR1C1 = t3903H
End If
If Trim(tele.sett) = "3904H" Then
t3904H = t3904H + 1
Range("C26").Select
ActiveCell.FormulaR1C1 = t3904H
End If
If Trim(tele.sett) = "3903V" Then
t3903V = t3903V + 1
Range("C27").Select
ActiveCell.FormulaR1C1 = t3903V
End If
If Trim(tele.sett) = "I2004" Then
ti2004V = ti2004V + 1
Range("C29").Select
ActiveCell.FormulaR1C1 = ti2004V
End If
If Trim(tele.sett) = "3904V" Then
t3904V = t3904V + 1
Range("C28").Select
ActiveCell.FormulaR1C1 = t3904V
End If
If Trim(tele.sett) = "2317" Then
t2317 = t2317 + 1
Range("C18").Select
ActiveCell.FormulaR1C1 = t2317
End If
If Trim(tele.sett) = "2216" Then
t2216 = t2216 + 1
Range("C14").Select
ActiveCell.FormulaR1C1 = t2216
End If
If InStr(1, Trim(tele.sett), "500") > 0 And Trim(tele.phntm) = "" Then
t500 = t500 + 1
Range("C9").Select
ActiveCell.FormulaR1C1 = t500
End If
If InStr(1, Trim(tele.sett), "500") > 0 And Trim(tele.phntm) = "PHANTOM" Then
t500p = t500p + 1
Range("C10").Select
ActiveCell.FormulaR1C1 = t500p
End If
If InStr(1, tele.sett, "SL1") > 0 Then
tsl1 = tsl1 + 1
Range("C15").Select
ActiveCell.FormulaR1C1 = tsl1
End If
DoEvents
For ff = 0 To 75
tele.key(ff) = Trim(tele.key(ff))
If InStr(1, tele.key(ff), "RING") Then tele.key(ff) = Left(tele.key(ff), InStr(1, tele.key(ff), "RING") - 1)
tele.key(ff) = Trim(tele.key(ff))
If InStr(1, tele.key(ff), "MARP") Then tele.key(ff) = Left(tele.key(ff), InStr(1, tele.key(ff), "MARP") - 1)
tele.key(ff) = Trim(tele.key(ff))
If InStr(1, tele.dn, "MARP") Then tele.dn = Left(tele.dn, InStr(1, tele.dn, "MARP") - 1)
tele.key(ff) = Trim(tele.key(ff))
If Trim(Right(tele.key(ff), 2)) = " 0" Then tele.key(ff) = Left(Trim(tele.key(ff)), Len(Trim(tele.key(ff))) - 2) Next ff If tele.hfa = "Y" Then tele.key(15) = "Hands free"
If tele.disp = "T" Then tele.key(7) = "Program" 'PRINT HERE-----------------------------------
rec = rec + 1
'Put #3, rec, tele For I = 1 To 75
If InStr(tele.key(I), "SCU") Then
tele.scc = Mid$(tele.key(I), 5, Len(za))
tele.cont = "U"
End If If InStr(tele.key(I), "CFW") Then
tele.dest = Trim(Mid$(tele.key(I), 7, Len(za)))
End If
If InStr(tele.key(I), "SCC") Then
tele.scc = Mid$(tele.key(I), 5, Len(za))
tele.cont = "C"
End If Next I
If Left(tele.dest, 3) = "919" Then tele.note = "CFW=1900"
DoEvents
'-------------------------------------------------
If InStr(1, tele.dn, "MARP") Then tele.dn = Left(tele.dn, InStr(1, tele.dn, "MARP") - 1)
If InStr(1, tele.dn, "R") Then tele.dn = Left(tele.dn, InStr(1, tele.dn, "R") - 2)
For mum = 1 To 6000
If Trim(ser(mum).Tnn) = Trim(tele.tn) Then
tele.code = ser(mum).code
tele.color = ser(mum).color
tele.rls = ser(mum).rls
tele.part = ser(mum).part
Exit For
End If
Next mum
Print #2, a; Trim(tele.tn); a; b;
Print #2, a; Trim(tele.dn); a; b;
Print #2, a; Trim(tele.marp); a; b;
Print #2, a; Trim(tele.sett); a; b;
If gotser = True Then
Print #2, a; Trim(tele.part); a; b;
Print #2, a; Trim(tele.color); a; b;
Print #2, a; Trim(tele.rls); a; b;
Print #2, a; Trim(tele.code); a; b;
End If
Print #2, a; Trim(tele.phntm); a; b;
Print #2, a; Trim(tele.wrls); a; b;
Print #2, a; Trim(tele.cden); a; b;
Print #2, a; Trim(tele.zone); a; b;
Print #2, a; Trim(tele.nam); a; b;
Print #2, a; Trim(tele.QU); a; b;
Print #2, a; Trim(tele.POSID); a; b;
Print #2, a; Trim(tele.dcfw); a; b;
Print #2, a; Trim(tele.dest); a; b;
Print #2, a; Trim(tele.note); a; b;
Print #2, a; Trim(tele.bar); a; b;
Print #2, a; Trim(tele.ncos); a; b;
Print #2, a; Trim(tele.rnpg); a; b;
Print #2, a; Trim(tele.hunt); a; b;
Print #2, a; Trim(tele.eht); a; b;
Print #2, a; Trim(tele.fdn); a; b;
Print #2, a; Trim(tele.efd); a; b;
Print #2, a; Trim(tele.rtda); a; b;
Print #2, a; Trim(tele.arto); a; b;
Print #2, a; Trim(tele.ahnt); a; b;
Print #2, a; Trim(tele.aeht); a; b;
Print #2, a; Trim(tele.afd); a; b;
Print #2, a; Trim(tele.aefd); a; b;
Print #2, a; Trim(tele.cust); a; b;
Print #2, a; Trim(tele.ten); a; b;
Print #2, a; Trim(tele.tgar); a; b;
Print #2, a; Trim(tele.sgrp); a; b;
Print #2, a; Trim(tele.scpw); a; b;
Print #2, a; Trim(tele.des); a; b;
Print #2, a; Trim(tele.aom); a; b;
Print #2, a; Trim(tele.fna); a; b;
Print #2, a; Trim(tele.cfta); a; b;
Print #2, a; Trim(tele.fba); a; b;
Print #2, a; Trim(tele.hta); a; b;
Print #2, a; Trim(tele.hbta); a; b;
Print #2, a; Trim(tele.scc) & Trim(tele.cont); a; b;
Print #2, a; Trim(tele.ddi); a; b;
Print #2, a; Trim(tele.mwa); a; b;
Print #2, a; Trim(tele.cfxa); a; b;
Print #2, a; Trim(tele.mta); a; b;
Print #2, a; Trim(tele.sfa); a; b;
Print #2, a; Trim(tele.xlst); a; b;
Print #2, a; Trim(tele.ast); a; b;
Print #2, a; Trim(tele.iapg); a; b;
If UserForm1.CheckBox2.Value Then
Print #2, a; Trim(tele.aaa); a; b;
Print #2, a; Trim(tele.acct); a; b;
Print #2, a; Trim(tele.agt); a; b;
Print #2, a; Trim(tele.aha); a; b;
Print #2, a; Trim(tele.aos); a; b;
Print #2, a; Trim(tele.arha); a; b;
Print #2, a; Trim(tele.c6a); a; b;
Print #2, a; Trim(tele.ccsa); a; b;
Print #2, a; Trim(tele.cfw); a; b;
Print #2, a; Trim(tele.cnda); a; b;
Print #2, a; Trim(tele.cwa); a; b;
Print #2, a; Trim(tele.dgr); a; b;
Print #2, a; Trim(tele.disp); a; b;
Print #2, a; Trim(tele.hfa); a; b;
Print #2, a; Trim(tele.hpr); a; b;
Print #2, a; Trim(tele.icda); a; b;
Print #2, a; Trim(tele.icf); a; b;
Print #2, a; Trim(tele.ira); a; b;
Print #2, a; Trim(tele.lna); a; b;
Print #2, a; Trim(tele.lpa); a; b;
Print #2, a; Trim(tele.mnl); a; b;
Print #2, a; Trim(tele.nama); a; b;
Print #2, a; Trim(tele.nia); a; b;
Print #2, a; Trim(tele.ola); a; b;
Print #2, a; Trim(tele.ovda); a; b;
Print #2, a; Trim(tele.phd); a; b;
Print #2, a; Trim(tele.plev); a; b;
Print #2, a; Trim(tele.poa); a; b;
Print #2, a; Trim(tele.rco); a; b;
Print #2, a; Trim(tele.rdl); a; b;
Print #2, a; Trim(tele.sci); a; b;
Print #2, a; Trim(tele.swa); a; b;
Print #2, a; Trim(tele.tsa); a; b;
End If
Print #2, a; Trim(tele.usra); a; b; If UserForm1.CheckBox2.Value Then
Print #2, a; Trim(tele.wta); a; b;
Print #2, a; Trim(tele.xfa); a; b;
Print #2, a; Trim(tele.xha); a; b;
Print #2, a; Trim(tele.xra); a; b;
Print #2, a; Trim(tele.kba); a; b;
Print #2, a; Trim(tele.dba); a; b;
Print #2, a; Trim(tele.flx); a; b;
Print #2, a; Trim(tele.sts); a; b;
Print #2, a; Trim(tele.crp); a; b;
Print #2, a; Trim(tele.grl); a; b;
Print #2, a; Trim(tele.drg); a; b;
End If If UserForm1.CheckBox3.Value Then
Print #2, a; Trim(tele.aacs); a; b;
Print #2, a; Trim(tele.acq); a; b;
Print #2, a; Trim(tele.asid); a; b;
Print #2, a; Trim(tele.sfnb); a; b;
Print #2, a; Trim(tele.sfnbn); a; b;
Print #2, a; Trim(tele.sfrb); a; b;
Print #2, a; Trim(tele.sfrbn); a; b;
Print #2, a; Trim(tele.usfb); a; b;
Print #2, a; Trim(tele.usfbn); a; b;
Print #2, a; Trim(tele.itna); a; b;
End If Print #2, a; Trim(tele.lhk); a;
If UserForm1.CheckBox1.Value Then
For ff = 0 To 75
If InStr(1, tele.key(ff), "RING") Then tele.key(ff) = Left(tele.key(ff), InStr(1, tele.key(ff), "RING") - 1)
If InStr(1, tele.key(ff), "MARP") Then tele.key(ff) = Left(tele.key(ff), InStr(1, tele.key(ff), "MARP") - 1)
Print #2, b; a; Trim(tele.key(ff)); a;
Next ff
End If
Print #2, b; a; Trim(tele.HOT); a;
Print #2, b; a; Trim(tele.Datt); a
tempkey = 99
tele = cleartele
tele.dn = "unknown"
'ReDim q(200) As String
End If
tempkey = 99
tele = cleartele
tele.dn = "unknown"
'ReDim q(200) As String
End If
tempkey = 99
tele = cleartele
tele.dn = "unknown"
'ReDim q(200) As String
End If
Wend
Reset
Workbooks.OpenText FileName:="C:\TEMP.PRN", Origin:=xlWindows, StartRow:= _
1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 2), Array(2, 2), _
Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2), _
Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2), Array(15, 2), Array( _
16, 2), Array(17, 2), Array(18, 2), Array(19, 2), Array(20, 2), Array(21, 2), Array(22, 2), _
Array(23, 2), Array(24, 2), Array(25, 2), Array(26, 2), Array(27, 2), Array(28, 2), Array( _
29, 2), Array(30, 2), Array(31, 2))
Cells.Select
Cells.EntireColumn.AutoFit
Range("D2").Select
ActiveWindow.FreezePanes = True
' Sheets("TEMP").Move Before:=Workbooks("mv.xls").Sheets(1)
Sheets("TEMP").Move Before:=Workbooks(wkbkname).Sheets(1)
Sheets("TEMP").Select
Sheets("TEMP").Name = sht
End Sub
|
