''полной очистки от лишнего не делала, так немного
Function task_Tabl3kp(Optional cRec& = 1, _
Optional dmode As Boolean = True)
Dim rs As DAO.Recordset
Dim i&, j&, ii&, s&, sr&, tel$, am@, note$, s1, j2
'On Error GoTo err123
If cRec < 1 Then cRec = 1
If dmode = False Then CurrentDb.Execute "delete * from Tabl", dbFailOnError
SysCmd acSysCmdSetStatus, "заполнено: " & 0 & " из " & cRec
Open "c:\rab\1256.txt" For Output As #1
Print #1, "tel;am;note1"
j2 = 0
For i = 1 To cRec
tel = "(" & Format(rnd99(), "000") & ")" & Format(rnd99(), "00") & "-" & Format(rnd999(), "000") & "-" & Format(rnd999(), "000")
am = rnd99() / 100
note = ""
ii = CInt(Math.Round((30) * Rnd())) + 1
For j = 0 To ii
s1 = Chr(CInt(Math.Round((ii) * Rnd())) + 40)
note = note & s1
Next j
'If InStr(note, "44") > 0 Then
If note Like "*4*4*" Then
note = note & "(reg) "
j2 = j2 + 1
If note > "999" Then
Debug.Print "="; i; j2;
End If
End If
If dmode = True Then
'Debug.Print "tel=" & tel, "am=" & am, "note=" & note
Print #1, tel, ";"; am; ";"; note
Else
CurrentDb.Execute "insert into Tabl(nomertel,summazvonka,opisanie) " & _
"values('" & tel & "'," & am & ",'" & note & "')"
', dbFailOnError
End If
' Debug.Print acSysCmdSetStatus, "заполнено: " & i & " из " & cRec: DoEvents
' SysCmd
Next i
Close #1
Exit Function
err123:
MsgBox Error, , "task_Tabl3k"
SysCmd acSysCmdClearStatus
Exit Function
End Function
|