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
|