Function Переброс_товара() As Boolean ' переброс из "ИЗ_1С" в "Товар"
On Error GoTo Переброс_товара_Error
Переброс_товара = True
ClearTable ("Товар") ' Очистка таблицы товар
Dim strIN As String
Dim strText As String
Dim txtKod As String '// 1 - код товара
Dim txtHK As String '// 2 - штрихкод товара
Dim txtNAME As String '// 3 - наименование
Dim txtNAMEKKM As String '// 4 - наименование для кассы
Dim txtCENA As String '// 5 - цена
Dim txtKol_Vo As String '// 6 - количество
Dim Строки As Long
Dim F As Integer
Dim i As Integer
Dim rs1 As DAO.Recordset
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("ИЗ_1С", dbOpenDynaset)
Set rs1 = CurrentDb.OpenRecordset("Товар", dbOpenDynaset)
If rs.EOF = False Then rs.MoveFirst
If rs1.EOF = False Then rs1.MoveFirst
Строки = 1
With rs
Do Until rs.EOF
If rs!поле1 = "##@@&&" Then GoTo dalee
If rs!поле1 = "#" Then GoTo dalee
If IsLoaded("Обмен") = True Then
Forms![Обмен]!Строк.SetFocus
Forms![Обмен]!Строк = Строки
Forms![Обмен].Recalc
Строки = Строки + 1
End If
strText = rs!поле1
i = 0
For F = 1 To 2
If i = 0 Then
i = InStr(1, strText, Chr(59)) 'Ищем первый ; в строке
txtKod = Mid(strText, 1, i - 1)
Else
strText = Mid(strText, i + 1) 'Убираем обработанное начало строки + 1 симв.
i = InStr(1, strText, Chr(59)) 'Ищем следующий ;
txtHK = Mid(strText, 1, i - 1) ' находим штрихкод
strText = Mid(strText, i + 1) 'Убираем обработанное начало строки + 1 симв.
i = InStr(1, strText, Chr(59)) 'Ищем следующий ;
txtNAME = Mid(strText, 1, i - 1) ' находим наименование
strText = Mid(strText, i + 1) 'Убираем обработанное начало строки + 1 симв.
i = InStr(1, strText, Chr(59)) 'Ищем следующий ;
txtNAMEKKM = Mid(strText, 1, i - 1) ' находим наименование для ккм
strText = Mid(strText, i + 1) 'Убираем обработанное начало строки + 1 симв.
i = InStr(1, strText, Chr(59)) 'Ищем следующий ;
txtCENA = Mid(strText, 1, i - 1) ' находим цена
strText = Mid(strText, i + 1) 'Убираем обработанное начало строки + 1 симв.
i = InStr(1, strText, Chr(59)) 'Ищем следующий ;
txtKol_Vo = Mid(strText, 1, i - 1) ' находим Количество
rs1.AddNew
rs1!Код_1С = txtKod
rs1!Штрихкод = txtHK
rs1!Наименование = txtNAME
rs1!Наименование_ККМ = txtNAMEKKM
rs1!Количество = Val(txtKol_Vo)
rs1!Цена = CCur(Val(txtCENA))
rs1.Update
'End If
'Exit For
End If
Next F
dalee:
.MoveNext
Loop
.Close
End With
Vihod:
rs1.Close
Set rs = Nothing
Set rs1 = Nothing
On Error GoTo 0
Exit Function
Переброс_товара_Error:
If Err.Number = "3022" Then
Call MsgBox("В загружаемом файе встреилось не уникальные значения штрихкода: " & txtHK _
& vbCrLf & "Загрузка товаров произведена не полностью." _
, vbCritical, "Предупреждение")
End If
Переброс_товара = False
Call Zapis_ERR("Module_Rasklad" & " процедура -> " & "Переброс_товара", Err.Number, Err.Description)
Err.Clear
End Function
|