Public Function FUN_LOAD_DIRECTORY_COMMODITY(STR_PATH As String) As Boolean
' Загрузка справочника товаров
Dim OpenParams()
Dim RST_GROUP As ADODB.Recordset
Dim RST_COMMODITY As ADODB.Recordset
Dim PP As Long ' номер строки
Dim GROUP_NUMBER As Long ' присвоим номер загружаемой группе
Dim GROUP_NAME As String ' имя группы
Dim STR_IN As String ' загружаемое значение из ячейки
Dim PUSTO As Long ' количество пустых строк
' Спасибо Osmor_у, иначе ничео не вышло бы
On Error GoTo FUN_LOAD_DIRECTORY_COMMODITY_Error
'----------------------------------------------------------------------------------
FUN_LOAD_DIRECTORY_COMMODITY = False
' если таковой не имеется сообщаем
If FUN_FILE_YES_NO(STR_PATH) = False Then
MsgBox "Файл " & STR_PATH & " не найден!!!"
Exit Function
End If
STR_PATH = ConvertToUrl(STR_PATH)
MsgBox "Пожалуйста нажмите ок и ждите дальнейшего сообщения..."
OOO_Index_Sheet = -1
' открываем книгу OpenOffice.org Calc
Call FUN_OOO_OPEN_BOOCK(STR_PATH)
If OOO_findSheetIndex(OOO_Document, "Остатки") <> -1 Then
' получим индекс листа
OOO_Index_Sheet = OOO_findSheetIndex(OOO_Document, "Остатки")
GoTo Dalee_Dalee
End If
' попытка найти лист NOMENKLATURA
If OOO_findSheetIndex(OOO_Document, "NOMENKLATURA") = -1 Then
' лист номенклатура "NOMENKLATURA" - не найден.
Call MESS("Листы (Остатки или NOMENKLATURA) - не найдены.")
' &" ' красный
'
'
Exit Function
Else
' получим индекс листа
OOO_Index_Sheet = OOO_findSheetIndex(OOO_Document, "NOMENKLATURA")
End If
Dalee_Dalee:
' получим ссылку на лист
Set OOO_Sheet = OOO_Document.getSheets().getByIndex(OOO_Index_Sheet)
' набор групп
Set RST_GROUP = New ADODB.Recordset
' очистка таблицы COMMODITY_GROUP_TB
Call FUN_CLEAR_TABLE("COMMODITY_GROUP_TBL", GLB_CONNECTION)
' открываем таблицу групп
RST_GROUP.Open "SELECT COMMODITY_GROUP_TBL.* From COMMODITY_GROUP_TBL ", GLB_CONNECTION, adOpenKeyset, adLockOptimistic
If RST_GROUP.RecordCount <> 0 Then
' очистка таблицы COMMODITY_GROUP_TB
Call FUN_CLEAR_TABLE("COMMODITY_GROUP_TBL", GLB_CONNECTION)
End If
' набор товаров
Set RST_COMMODITY = New ADODB.Recordset
' очистка таблицы COMMODITY_TBL
Call FUN_CLEAR_TABLE("COMMODITY_TBL", GLB_CONNECTION)
' открываем таблицу товаров
RST_COMMODITY.Open "SELECT COMMODITY_TBL.* From COMMODITY_TBL ", GLB_CONNECTION, adOpenKeyset, adLockOptimistic
If RST_COMMODITY.RecordCount <> 0 Then
' очистка таблицы COMMODITY_TBL
Call FUN_CLEAR_TABLE("COMMODITY_TBL", GLB_CONNECTION)
End If
If RST_COMMODITY.RecordCount = 0 Then
GROUP_NUMBER = 0
For PP = 1 To 10
STR_IN = ""
Set OOO_Range = OOO_Sheet.getCellByPosition(0, PP)
STR_IN = OOO_Range.GetString
If InStr(1, STR_IN, "Группа", vbTextCompare) <> 0 Then Exit For
Next PP
For PP = PP To 100000
STR_IN = ""
Set OOO_Range = OOO_Sheet.getCellByPosition(0, PP)
If OOO_Range.Value = 0 Then
STR_IN = OOO_Range.GetString
Else
STR_IN = OOO_Range.Value
End If
' пошли пустые строки, если пустых будет более чем , тогда конец загрузке
If STR_IN = "" Then
PUSTO = PUSTO + 1
GoTo Dalee
End If
'сделать первую букву каждого слова заглавной
' If IsNull(STR_IN) = False Then
' STR_IN = StrConv(STR_IN, vbProperCase)
' End If
' пошли пустые строки
If InStr(1, STR_IN, "Группа", vbTextCompare) <> 0 Then ' это группа
If InStr(1, STR_IN, "7Группа", vbTextCompare) <> 0 Then ' это группа
STR_IN = Mid(STR_IN, 2)
End If
RST_GROUP.AddNew
GROUP_NAME = STR_IN
RST_GROUP("GROUP_NAME") = STR_IN
RST_GROUP("USER_NAME") = GLB_USER_NAME
RST_GROUP("DATE_RECORDS") = Date
RST_GROUP.Update
GROUP_NUMBER = RST_GROUP("GROUP_NUMBER")
Else
RST_COMMODITY.AddNew
' Идентификатор товара.
Set OOO_Range = OOO_Sheet.getCellByPosition(15, PP)
STR_IN = ""
If OOO_Range.Value = 0 Then
STR_IN = OOO_Range.GetString
Else
STR_IN = OOO_Range.Value
End If
If NZVB(STR_IN) <> "" Then
' товар уже с идентификатором (не новый) изменим данные
RST_COMMODITY("ID_COMMODITY") = STR_IN
Else
' товар новый
RST_COMMODITY("ID_COMMODITY") = FUN_GENERATE
End If
' Наименование
Set OOO_Range = OOO_Sheet.getCellByPosition(0, PP)
STR_IN = ""
If OOO_Range.Value = 0 Then
STR_IN = OOO_Range.GetString
Else
STR_IN = OOO_Range.Value
End If
'сделать первую букву каждого слова заглавной
' If IsNull(STR_IN) = False Then
' STR_IN = StrConv(STR_IN, vbProperCase)
' End If
RST_COMMODITY("GROUP_NUMBER") = RST_GROUP("GROUP_NUMBER")
RST_COMMODITY("GROUP_NAME") = GROUP_NAME
RST_COMMODITY("COMMODITY_NAME") = STR_IN
RST_COMMODITY("COMMODITY_NAME_IN_KKM") = STR_IN
' Цена товара.
Set OOO_Range = OOO_Sheet.getCellByPosition(8, PP)
STR_IN = ""
If OOO_Range.Value = 0 Then
STR_IN = OOO_Range.GetString
Else
STR_IN = OOO_Range.Value
End If
RST_COMMODITY("PRICE_COMMODITY") = STR_IN
' Ед. изм
Set OOO_Range = OOO_Sheet.getCellByPosition(9, PP)
STR_IN = ""
If OOO_Range.Value = 0 Then
STR_IN = OOO_Range.GetString
Else
STR_IN = OOO_Range.Value
End If
RST_COMMODITY("METAGE") = STR_IN
' Цена закуп.
Set OOO_Range = OOO_Sheet.getCellByPosition(10, PP)
STR_IN = ""
If OOO_Range.Value = 0 Then
STR_IN = OOO_Range.GetString
Else
STR_IN = OOO_Range.Value
End If
RST_COMMODITY("OPTO_PRICE") = Val(STR_IN)
' Описание производитель
Set OOO_Range = OOO_Sheet.getCellByPosition(11, PP)
STR_IN = ""
If OOO_Range.Value = 0 Then
STR_IN = OOO_Range.GetString
Else
STR_IN = OOO_Range.Value
End If
RST_COMMODITY("DESCRIPTION") = STR_IN
' Минимальный остаток
Set OOO_Range = OOO_Sheet.getCellByPosition(12, PP)
STR_IN = ""
If OOO_Range.Value = 0 Then
STR_IN = OOO_Range.GetString
Else
STR_IN = OOO_Range.Value
End If
RST_COMMODITY("MINIMUM") = Val(STR_IN)
' Количество
Set OOO_Range = OOO_Sheet.getCellByPosition(13, PP)
STR_IN = ""
If OOO_Range.Value = 0 Then
STR_IN = OOO_Range.GetString
Else
STR_IN = OOO_Range.Value
End If
RST_COMMODITY("AMOUNT") = Val(STR_IN)
' ' штрихкод
Set OOO_Range = OOO_Sheet.getCellByPosition(16, PP)
STR_IN = ""
If OOO_Range.Value = 0 Then
STR_IN = OOO_Range.GetString
Else
STR_IN = OOO_Range.Value
End If
RST_COMMODITY("SHTRIHKOD") = STR_IN
RST_COMMODITY.Update ' обновить
End If
Dalee:
' пошли пустые строки
If PUSTO >= 20 Then Exit For
Next PP
FUN_LOAD_DIRECTORY_COMMODITY = True
End If
'
' заполняем наименованиями групп товаров
RST_GROUP.Close
Set RST_GROUP = Nothing
RST_COMMODITY.Close
Set RST_COMMODITY = Nothing
'закрываем созданную книгу
Call OOO_Document.Close(False)
Set OOO_Document = Nothing
Set OOO_Sheet = Nothing
Set OOO_Desktop = Nothing
Set OpenOffice = Nothing
'----------------------------------------------------------------------------------
On Error GoTo 0
Exit Function
FUN_LOAD_DIRECTORY_COMMODITY_Error:
Call FUN_IN_TXT(FUN_Patch_File(App.Path, "Error.txt"), "Error " & Err.Number & " (" & Err.Description & ") in procedure FUN_LOAD_DIRECTORY_COMMODITY of Module DOCS_MOD")
End Function
|