, !
, ()!




WRITE LETTER

SAPE

3


3 analiz.xls . . Sub 3() ' ' 3 ' 12.03.2013 (UserXP) ' ' : Ctrl+a ' Dim a As String Dim a1 As String Dim a2 As String Dim a3 As String Dim a4 As String Dim a5 As String Dim a6 As String Dim a7 As String Dim s As String Dim s1 As String Dim s2 As String Dim s3 As String Dim s4 As String Dim d As String Dim ss As String Dim ss1 As String Dim n As Integer Dim n1 As Integer Dim n2 As Integer Dim nn As Integer Dim b As String Dim b1 As String Dim b2 As String Dim b3 As String Dim b4 As String Dim b5 As String Dim b6 As String Dim b7 As String Dim z As String Dim z1 As String Dim z2 As String Dim z3 As String Dim z4 As String Dim zz As String Dim zz1 As String Dim m As Integer Dim m1 As Integer Dim m2 As Integer Dim mm As Integer Dim ta As String Dim ta1 As String Dim ta2 As String Dim ta3 As String Dim ta4 As String Dim ta5 As String Dim ta6 As String Dim ta7 As String Dim ts As String Dim ts1 As String Dim ts2 As String Dim ts3 As String Dim ts4 As String Dim tss As String Dim tss1 As String Dim tn As Integer Dim tn1 As Integer Dim tn2 As Integer Dim tnn As Integer Dim tb As String Dim tb1 As String Dim tb2 As String Dim tb3 As String Dim tb4 As String Dim tb5 As String Dim tb6 As String Dim tb7 As String Dim tz As String Dim tz1 As String Dim tz2 As String Dim tz3 As String Dim tz4 As String Dim tzz As String Dim tzz1 As String Dim tm As Integer Dim tm1 As Integer Dim tm2 As Integer Dim tmm As Integer Dim ssnew As String Dim s1new As String Dim a8 As String Dim zznew As String Dim z1new As String Dim b8 As String Dim tssnew As String Dim ts1new As String Dim ta8 As String Dim tzznew As String Dim tz1new As String Dim tb8 As String '--------------------------------------------------------------------------------- ' ANALIZ "" MINIHALVA For nn = 2 To 1000 a1 = Application.Workbooks("analiz.xls").Sheets("1").Cells(nn, 4).Value 'url a2 = Left(a1, 24) a = "http://www.minihalva.ru/" If a2 = a Then a3 = Mid(a1, 25) n = Len(a3) a4 = Left(a3, n - 5) ' - 'MsgBox a4 a5 = ".txt" a7 = ".html" a6 = a4 + a5 ' - txt a8 = a4 + a7 ' - html 'MsgBox a6 ' "s" s1 = "D:\minihalva\txt\" s1new = Left(s1, 13) ss = s1 + a6 ssnew = s1new + a8 ' MsgBox ssnew Open ss For Input As #1 s = Input(LOF(1), 1) Close #1 s2 = "" n1 = InStr(s, s2) s3 = Left(s, n1 + 45) Open "D:\minihalva\txt\dno.txt" For Input As #1 d = Input(LOF(1), 1) Close #1 s4 = s3 + d Open ss For Output As #1 Print #1, s4 Close #1 FileCopy ss, ssnew Else GoTo blia End If Next nn blia: 'Application.Workbooks("analiz.xls").Sheets("1").Cells(1, 2) = "MINIHALVA" 'Application.Workbooks("analiz.xls").Sheets("1").Cells(1, 1).Interior.Colorxindex = 4 '--------------------------------------------------------------------------------- '--------------------------------------------------------------------------------- ' ANALIZ "" MINIHALVA For mm = 2 To 1000 b1 = Application.Workbooks("analiz.xls").Sheets("1").Cells(mm, 1).Value 'url b2 = Left(b1, 24) b = "http://www.minihalva.ru/" If b2 = b Then b3 = Mid(b1, 25) 'MsgBox b3 m = Len(b3) b4 = Left(b3, m - 5) ' - 'MsgBox b4 b5 = ".txt" b7 = ".html" b6 = b4 + b5 ' - txt b8 = b4 + b7 ' - html 'MsgBox b6 ' "z" z1 = "D:\minihalva\txt\" z1new = Left(z1, 13) zz = z1 + b6 zznew = z1new + b8 'MsgBox zznew Open zz For Input As #1 z = Input(LOF(1), 1) Close #1 z2 = "" m1 = InStr(z, z2) z3 = Left(z, m1 + 45) d1 = Application.Workbooks("analiz.xls").Sheets("1").Cells(mm, 2).Value ' Open "D:\minihalva\txt\dno.txt" For Input As #1 d = Input(LOF(1), 1) Close #1 z4 = z3 + Chr(13) + Chr(10) + d1 + d Open zz For Output As #1 Print #1, z4 Close #1 FileCopy zz, zznew Else GoTo xer End If Next mm xer: '--------------------------------------------------------------------------------- ' '--------------------------------------------------------------------------------- ' ANALIZ "" xtexSPRAVKA For tnn = 2 To 1000 ta1 = Application.Workbooks("analiz.xls").Sheets("1").Cells(tnn, 10).Value 'url ta2 = Left(ta1, 25) ta = "http://www.xtexspravka.ru/" If ta2 = ta Then ta3 = Mid(ta1, 26) tn = Len(ta3) ta4 = Left(ta3, tn - 5) ' - 'MsgBox a4 ta5 = ".txt" ta7 = ".html" ta6 = ta4 + ta5 ' - txt ta8 = ta4 + ta7 ' - html 'MsgBox a6 ' "ts" ts1 = "D:\xtexspravka\txt\" ts1new = Left(ts1, 14) tss = ts1 + ta6 tssnew = ts1new + ta8 ' MsgBox tssnew Open tss For Input As #1 ts = Input(LOF(1), 1) Close #1 ts2 = "" tn1 = InStr(ts, ts2) ts3 = Left(ts, tn1 + 45) Open "D:\minihalva\txt\dno.txt" For Input As #1 d = Input(LOF(1), 1) Close #1 ts4 = ts3 + d Open tss For Output As #1 Print #1, ts4 Close #1 FileCopy tss, tssnew Else GoTo tblia End If Next tnn tblia: '--------------------------------------------------------------------------------- '--------------------------------------------------------------------------------- ' ANALIZ "" xtexSPRAVKA For tmm = 2 To 1000 tb1 = Application.Workbooks("analiz.xls").Sheets("1").Cells(tmm, 7).Value 'url tb2 = Left(tb1, 25) tb = "http://www.xtexspravka.ru/" If tb2 = tb Then tb3 = Mid(tb1, 26) tm = Len(tb3) tb4 = Left(tb3, tm - 5) ' - 'MsgBox b4 tb5 = ".txt" tb7 = ".html" tb6 = tb4 + tb5 ' - txt tb8 = tb4 + tb7 ' - html 'MsgBox b6 ' "tz" tz1 = "D:\xtexspravka\txt\" tz1new = Left(tz1, 14) tzz = tz1 + tb6 tzznew = tz1new + tb8 ' MsgBox tzznew Open tzz For Input As #1 tz = Input(LOF(1), 1) Close #1 tz2 = "" tm1 = InStr(tz, tz2) tz3 = Left(tz, tm1 + 45) td1 = Application.Workbooks("analiz.xls").Sheets("1").Cells(tmm, 8).Value ' Open "D:\minihalva\txt\dno.txt" For Input As #1 d = Input(LOF(1), 1) Close #1 tz4 = tz3 + Chr(13) + Chr(10) + td1 + d Open tzz For Output As #1 Print #1, tz4 Close #1 FileCopy tzz, tzznew Else GoTo txer End If Next tmm txer: '--------------------------------------------------------------------------------- ' End Sub     - .