Форум: "Corba";
Текущий архив: 2007.04.08;
Скачать: [xml.tar.bz2];
ВнизОбработка *.xls файлов Найти похожие ветки
← →
Explorer (2005-11-02 12:35) [0]Мастера!
Задача: в папке *.xls файлы (оборотно-сальдовые ведомости). Их надо обработать и сформировать на основе полученных данных отдельную ведомость (не обязательно в *.xls, подойдет к ex.: и FastReport).
Посоветуйте какую-нибудь толковую статейку с кодом или просто пример кода работы с Excel файлами или какой-нибудь альтернативный вариант решения данной задачи?
← →
isasa © (2005-11-02 13:04) [1]Разгребел архив.
Работа с почтовой формой и запись в базу MS SQL. Под wscript.exe (cscript.exe).
Принцип из-под D, тот-же :)" append103.vbs
"The location of the cursor service.
Const adUseClient = 3
Const adUseNone = 1
Const adUseServer = 2
"The level of transaction isolation for a Connection object.
Const adXactUnspecified = -1
Const adXactChaos = 16
Const adXactBrowse = 256
Const adXactReadUncommitted = 256
Const adXactCursorStability = 4096
Const adXactReadCommitted = 4096
Const adXactRepeatableRead = 65536
Const adXactIsolated = 1048576
Const adXactSerializable = 1048576
"The type of cursor used in a Recordset object.
Const adOpenDynamic = 2
Const adOpenForwardOnly = 0
Const adOpenKeyset = 1
Const adOpenStatic = 3
Const adOpenUnspecified = -1
"The type of lock placed on records during editing.
Const adLockBatchOptimistic = 4
Const adLockOptimistic = 3
Const adLockPessimistic = 2
Const adLockReadOnly = 1
Const adLockUnspecified = -1
"How a command argument should be interpreted.
Const adCmdUnspecified = -1 "Does not specify the command type argument.
Const adCmdText = 1 "Evaluates CommandText as a textual definition of a command or stored procedure call.
Const adCmdTable = 2 "Evaluates CommandText as a table name whose columns are all returned by an internally generated SQL query.
Const adCmdStoredProc = 4 "Evaluates CommandText as a stored procedure name.
Const adCmdUnknown = 8 "Default. Indicates that the type of command in the CommandText property is not known.
Const adCmdFile = 256 "Evaluates CommandText as the file name of a persistently stored Recordset.
Const adCmdTableDirect = 512 "Evaluates CommandText as a table name whose columns are all returned.
"How a provider should execute a command.
Const adAsyncExecute = 16
Const adAsyncFetch = 32
Const adAsyncFetchNonBlocking = 64
Const adExecuteNoRecords = 128
Const adOptionUnspecified = -1
"------------------------------------------------------------------------------
Dim fileName, objArgs
Dim appExcel
Dim Header, Sour, stat
Dim strProv, i, j
Dim ordID, fNo, sender, retAdd
Dim fsObj, fSpec
Dim Created, LastAccessed, LastModified
on error resume next
Set objArgs = WScript.Arguments
fileName=objArgs(0)
Set fsObj = CreateObject("Scripting.FileSystemObject")
Set fSpec = fsObj.GetFile(fileName)
if Err<>0 then
WScript.Echo WScript.ScriptName & " error! " & CStr(Err.Number) & " " & Err.Description & " " & Err.Source
WScript.Quit
end if
Created=fSpec.DateCreated
LastAccessed=fSpec.DateLastAccessed
LastModified=fSpec.DateLastModified
Set appExcel = WScript.CreateObject( "Excel.Application" )
"appExcel.Visible = True
appExcel.Workbooks.Open fileName
"appExcel.Worksheets(1).Activate
if Err<>0 then
WScript.Echo WScript.ScriptName & " error! " & CStr(Err.Number) & " " & Err.Description & " " & Err.Source
WScript.Quit
end if
Set Sour = appExcel.Worksheets(1).Range("source")
Set Header = appExcel.Worksheets(3).Range("Header103")
if Err<>0 then
WScript.Echo WScript.ScriptName & " error! " & CStr(Err.Number) & " " & Err.Description & " " & Err.Source
WScript.Echo "Error! No range "source" or "Header103" in " & fileName
appExcel.Quit
Set appExcel = Nothing
WScript.Quit
end if
if not Check103(Header) then
WScript.Echo "Error! No right 103 header!"
appExcel.Quit
Set appExcel = Nothing
WScript.Quit
end if
Set stat = appExcel.Worksheets(3).Range("stat")
if Err=0 then
Created=stat.Cells(2, 3).Value
LastAccessed=stat.Cells(3, 3).Value
LastModified=stat.Cells(4, 3).Value
end if
on error goto 0
Set Header = appExcel.Worksheets(1).Range(appExcel.Worksheets(1).Cells(1,1),appExcel.Worksheets(1).Cells(8,11))
fNo=IsHeader103(Header, j, sender, retAdd)
WScript.Echo "?яшёюъ ? " & fNo & " (?юЁьр 103-1) ?ьхэхэш : " & CStr(Created) & " ?рёяхўрЄър: " & CStr(LastAccessed) & _
" ?юїЁрэхэшх: " & CStr(LastModified)
WScript.Echo "??фяЁртэшъ:" & sender
WScript.Echo "?тюЁюЄэ рфЁхёр:" & retAdd
Set connADO = WScript.CreateObject("ADODB.Connection")
connADO.CursorLocation = adUseServer "?с чрЄхы№эю т?яюыэхэшх эр ёхЁтхЁх !!!!!!!
connADO.IsolationLevel = adXactCursorStability
strProv="Provider=SQLOLEDB.1;User ID = sa;Initial Catalog = Multipost;Data Source = sterver;"
connADO.Open strProv
WScript.Echo "- ?рўрыю ЄЁрэчръЎшш -"
connADO.BeginTrans
i=CheckExistRec(fNo, connADO)
Set rstOrder = WScript.CreateObject("ADODB.Recordset")
rstOrder.CursorType = adOpenKeyset
rstOrder.LockType = adLockOptimistic
rstOrder.Open "orders", connADO, , , adCmdTable
rstOrder.AddNew
rstOrder.Fields("fNo").Value = fNo
rstOrder.Fields("sender").Value = sender
rstOrder.Fields("retAddress").Value = retAdd
rstOrder.Fields("LastEdit").Value = Created
rstOrder.Fields("LastPrint").Value = LastAccessed
rstOrder.Fields("LastSave").Value = LastModified
rstOrder.Update
ordID=rstOrder.Fields("id").Value
i=AppendF103(rstOrder.Fields("id").Value, connADO, Sour, Header)
connADO.CommitTrans
WScript.Echo "- ?ЁрэчръЎш єёях°эю чртхЁ°хэр -"
rstOrder.Close
connADO.Close
appExcel.Quit
Set appExcel = Nothing
WScript.Echo "Done!"
"WScript.Sleep 5000
← →
isasa © (2005-11-02 13:06) [2]Сорри - кодировка
"The location of the cursor service.
Const adUseClient = 3
Const adUseNone = 1
Const adUseServer = 2
"The level of transaction isolation for a Connection object.
Const adXactUnspecified = -1
Const adXactChaos = 16
Const adXactBrowse = 256
Const adXactReadUncommitted = 256
Const adXactCursorStability = 4096
Const adXactReadCommitted = 4096
Const adXactRepeatableRead = 65536
Const adXactIsolated = 1048576
Const adXactSerializable = 1048576
"The type of cursor used in a Recordset object.
Const adOpenDynamic = 2
Const adOpenForwardOnly = 0
Const adOpenKeyset = 1
Const adOpenStatic = 3
Const adOpenUnspecified = -1
"The type of lock placed on records during editing.
Const adLockBatchOptimistic = 4
Const adLockOptimistic = 3
Const adLockPessimistic = 2
Const adLockReadOnly = 1
Const adLockUnspecified = -1
"How a command argument should be interpreted.
Const adCmdUnspecified = -1 "Does not specify the command type argument.
Const adCmdText = 1 "Evaluates CommandText as a textual definition of a command or stored procedure call.
Const adCmdTable = 2 "Evaluates CommandText as a table name whose columns are all returned by an internally generated SQL query.
Const adCmdStoredProc = 4 "Evaluates CommandText as a stored procedure name.
Const adCmdUnknown = 8 "Default. Indicates that the type of command in the CommandText property is not known.
Const adCmdFile = 256 "Evaluates CommandText as the file name of a persistently stored Recordset.
Const adCmdTableDirect = 512 "Evaluates CommandText as a table name whose columns are all returned.
"How a provider should execute a command.
Const adAsyncExecute = 16
Const adAsyncFetch = 32
Const adAsyncFetchNonBlocking = 64
Const adExecuteNoRecords = 128
Const adOptionUnspecified = -1
"------------------------------------------------------------------------------
Dim fileName, objArgs
Dim appExcel
Dim Header, Sour, stat
Dim strProv, i, j
Dim ordID, fNo, sender, retAdd
Dim fsObj, fSpec
Dim Created, LastAccessed, LastModified
on error resume next
Set objArgs = WScript.Arguments
fileName=objArgs(0)
Set fsObj = CreateObject("Scripting.FileSystemObject")
Set fSpec = fsObj.GetFile(fileName)
if Err<>0 then
WScript.Echo WScript.ScriptName & " error! " & CStr(Err.Number) & " " & Err.Description & " " & Err.Source
WScript.Quit
end if
Created=fSpec.DateCreated
LastAccessed=fSpec.DateLastAccessed
LastModified=fSpec.DateLastModified
Set appExcel = WScript.CreateObject( "Excel.Application" )
"appExcel.Visible = True
appExcel.Workbooks.Open fileName
"appExcel.Worksheets(1).Activate
if Err<>0 then
WScript.Echo WScript.ScriptName & " error! " & CStr(Err.Number) & " " & Err.Description & " " & Err.Source
WScript.Quit
end if
Set Sour = appExcel.Worksheets(1).Range("source")
Set Header = appExcel.Worksheets(3).Range("Header103")
if Err<>0 then
WScript.Echo WScript.ScriptName & " error! " & CStr(Err.Number) & " " & Err.Description & " " & Err.Source
WScript.Echo "Error! No range "source" or "Header103" in " & fileName
appExcel.Quit
Set appExcel = Nothing
WScript.Quit
end if
if not Check103(Header) then
WScript.Echo "Error! No right 103 header!"
appExcel.Quit
Set appExcel = Nothing
WScript.Quit
end if
Set stat = appExcel.Worksheets(3).Range("stat")
if Err=0 then
Created=stat.Cells(2, 3).Value
LastAccessed=stat.Cells(3, 3).Value
LastModified=stat.Cells(4, 3).Value
end if
on error goto 0
Set Header = appExcel.Worksheets(1).Range(appExcel.Worksheets(1).Cells(1,1),appExcel.Worksheets(1).Cells(8,11))
fNo=IsHeader103(Header, j, sender, retAdd)
WScript.Echo "Список № " & fNo & " (Форма 103-1) Именения: " & CStr(Created) & " Распечатка: " & CStr(LastAccessed) & _
" Сохранение: " & CStr(LastModified)
WScript.Echo "В_дправник:" & sender
WScript.Echo "Зворотня адреса:" & retAdd
Set connADO = WScript.CreateObject("ADODB.Connection")
connADO.CursorLocation = adUseServer "Обязательно выполнение на сервере !!!!!!!
connADO.IsolationLevel = adXactCursorStability
strProv="Provider=SQLOLEDB.1;User ID = sa;Initial Catalog = Multipost;Data Source = sterver;"
connADO.Open strProv
WScript.Echo "- Начало транзакции -"
connADO.BeginTrans
i=CheckExistRec(fNo, connADO)
Set rstOrder = WScript.CreateObject("ADODB.Recordset")
rstOrder.CursorType = adOpenKeyset
rstOrder.LockType = adLockOptimistic
rstOrder.Open "orders", connADO, , , adCmdTable
rstOrder.AddNew
rstOrder.Fields("fNo").Value = fNo
rstOrder.Fields("sender").Value = sender
rstOrder.Fields("retAddress").Value = retAdd
rstOrder.Fields("LastEdit").Value = Created
rstOrder.Fields("LastPrint").Value = LastAccessed
rstOrder.Fields("LastSave").Value = LastModified
rstOrder.Update
ordID=rstOrder.Fields("id").Value
i=AppendF103(rstOrder.Fields("id").Value, connADO, Sour, Header)
connADO.CommitTrans
WScript.Echo "- Транзакция успешно завершена -"
rstOrder.Close
connADO.Close
appExcel.Quit
Set appExcel = Nothing
WScript.Echo "Done!"
"WScript.Sleep 5000
← →
isasa © (2005-11-02 13:07) [3]Это функции.
"--------------------------------------------------------------------------------------------------------------
Function IsHeader103(hRange, j, sender, retAdd)
Dim buf,i
IsHeader103 = ""
buf = hRange.Cells(1, 5).Value
If hRange.Cells(1, 2).Value = "СПИСОК" Then
if InStr(buf, "/")=0 then
IsHeader103 = buf
else
IsHeader103 = Left(buf, InStr(buf, "/") - 1)
end if
j = hRange.Cells(1, 6).Value
End If
i = InStr(hRange.Cells(4, 2).Value, "В_дправник:")
If i Then sender = Mid(hRange.Cells(4, 2).Value, i + Len("В_дправник:"))
i = InStr(hRange.Cells(5, 2).Value, "Зворотня адреса:")
If i Then retAdd = Mid(hRange.Cells(5, 2).Value, i + Len("Зворотня адреса:"))
End Function
Function CheckExistRec(fNo, connDB)
Dim rstDB
Dim strSQL, strWhere
Dim i
CheckExistRec = 0
Set rstDB = WScript.CreateObject("ADODB.Recordset")
strWhere="WHERE (fNo like "" & fNo & "%")"
strSQL = "SELECT * FROM orders " & strWhere
rstDB.Open strSQL, connDB, , , adCmdText
if not(rstDB.EOF and rstDB.BOF) then
i = 0
rstDB.MoveFirst
Do While Not rstDB.EOF
i = i + 1
rstDB.MoveNext
Loop
end if
rstDB.Close
if i > 0 then
strSQL = "DELETE FROM orders " & strWhere
set rstDB = connDB.Execute(strSQL, i, adCmdText)
WScript.Echo i, " удалено! (""" & strWhere & """)"
End If
End Function
Function Check103(h)
Dim i,j
Check103 = (InStr(h.Cells(6,6).Value, "Плата")<>0)
Check103 = Check103 And (InStr(h.Cells(7,1).Value, "№")<>0)
Check103 = Check103 And (InStr(h.Cells(7,2).Value, "Кому")<>0)
Check103 = Check103 And (InStr(h.Cells(7,3).Value, "Сума")<>0)
Check103 = Check103 And (InStr(h.Cells(7,4).Value, "Сума")<>0)
Check103 = Check103 And (InStr(h.Cells(7,5).Value, "Маса,")<>0)
Check103 = Check103 And (InStr(h.Cells(7,6).Value, "за оголошену")<>0)
Check103 = Check103 And (InStr(h.Cells(7,7).Value, "за массу")<>0)
Check103 = Check103 And (InStr(h.Cells(7,8).Value, "пов_домлення")<>0)
Check103 = Check103 And (InStr(h.Cells(7,9).Value, "всього")<>0)
"For i=1 To h.Rows.Count
" WScript.Echo CStr(i) & "->" & h.Cells(i,6).Value & " InStr=" & CStr(InStr(h.Cells(i,6).Value, "Плата"))
"Next
End Function
Function AppendF103(orderID, connDB, source, header)
Dim i,j
Dim rstF103, rstF103det
Dim f103, intf103, sender, retAddr
AppendF103 = 0
Set rstF103 = WScript.CreateObject("ADODB.Recordset")
Set rstF103det = WScript.CreateObject("ADODB.Recordset")
rstF103.CursorType = adOpenKeyset
rstF103.LockType = adLockOptimistic
rstF103.Open "f103", connDB, , , adCmdTable
rstF103det.CursorType = adOpenKeyset
rstF103det.LockType = adLockOptimistic
rstF103det.Open "f103detail", connDB, , , adCmdTable
f103 = IsHeader103(header, intf103, sender, retAddr)
For i = 1 To source.Rows.Count
j=IsHeader103(source.Range(source.Cells(i, 1), source.Cells(i + 5, 11)), intf103, sender, retAddr)
If InStr(source.Cells(i, 2).Value, "Разом:") Then
WScript.Echo f103 & "/" & intf103 & chr(9) & CStr(source.Cells(i, 9).Value) & " грн. " & chr(9) & source.Cells(i, 2).Value
rstF103.AddNew
rstF103.Fields("orderID").Value = orderID
rstF103.Fields("fNo").Value = intf103
rstF103.Fields("ocSum").Value = source.Cells(i, 3).Value
rstF103.Fields("ppSum").Value = source.Cells(i, 4).Value
rstF103.Fields("Weight").Value = source.Cells(i, 5).Value
rstF103.Fields("ocPay").Value = source.Cells(i, 6).Value
rstF103.Fields("wPay").Value = source.Cells(i, 7).Value
rstF103.Fields("msgPay").Value = source.Cells(i, 8).Value
rstF103.Fields("total").Value = source.Cells(i, 9).Value
rstF103.Fields("packCount").Value = source.Cells(i - 1, 1).Value
rstF103.Fields("Comment").Value = source.Cells(i, 2).Value
rstF103.Update
f103ID = rstF103.Fields("ID").Value
AppendF103 = AppendF103 + 1
For j = (i - source.Cells(i - 1, 1).Value) To i - 1
rstF103det.AddNew
rstF103det.Fields("formID").Value = f103ID
rstF103det.Fields("pNo").Value = source.Cells(j, 1).Value
rstF103det.Fields("Address").Value = source.Cells(j, 2).Value
rstF103det.Fields("ocSum").Value = source.Cells(j, 3).Value
rstF103det.Fields("ppSum").Value = source.Cells(j, 4).Value
rstF103det.Fields("Weight").Value = source.Cells(j, 5).Value
rstF103det.Fields("ocPay").Value = source.Cells(j, 6).Value
rstF103det.Fields("wPay").Value = source.Cells(j, 7).Value
rstF103det.Fields("msgPay").Value = source.Cells(j, 8).Value
rstF103det.Fields("total").Value = source.Cells(j, 9).Value
rstF103det.Fields("Comment").Value = CStr(intf103)
rstF103det.Update
Next
End If
Next
rstF103det.Close
rstF103.Close
End Function
← →
Explorer (2005-11-02 13:10) [4]>isasa
спасибки. попытаюсь разобраться
← →
Polevi © (2005-11-03 12:17) [5]проще работать с Excel файлом как с таблицей через ADO
← →
Explorer (2005-11-03 14:23) [6]а примерчик можно?
← →
isasa © (2005-11-03 14:26) [7]Polevi © (03.11.05 12:17) [5]
Да. Только именованные диапазоны, теряем.
← →
Polevi © (2005-11-03 14:58) [8]var
conn:OleVariant
begin
conn:=CreateOleObject("ADODB.Connection");
conn.Open(Format("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;Extended Properties="Excel 8.0;HDR=NO"",[AFileName]));
AdoDataset1.Recordset:=conn.Execute(Format(s,[ASheetName]));
← →
Polevi © (2005-11-03 15:04) [9]PS
s - запрос, наример такой
SELECT F3 AS GOODID,F6 AS QTY FROM [%s$11:10000]
Страницы: 1 вся ветка
Форум: "Corba";
Текущий архив: 2007.04.08;
Скачать: [xml.tar.bz2];
Память: 0.51 MB
Время: 0.079 c