Текущий архив: 2007.04.08;
Скачать: CL | DM;

Вниз

Обработка *.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 вся ветка

Текущий архив: 2007.04.08;
Скачать: CL | DM;

Наверх

Память: 0.52 MB
Время: 0.031 c