Привет !!!

Написал прогу на ВБ создаю программно dbf таблицу сажаю в нее данные из нескольких таблиц Excel проверяю нет ли в dbf одинаковых записей путем копирования неодинаковых записей в таблицу специально созданную Temp.dbf затем удаляю исходную таблицу Prost_SystemsДДММ.dbf и переиеновываю Temp.dbf в Prost_SystemsДДММ.dbf.
Проблема при переименовании файла, выходит ошибка " error 55 File already open ". Файл сидит открытым, вроде все ссылки закрываю. Тоде и с таблицами Excel после работы программы файлы кагбутто еще мною открыты , то есть сидят в процессах. Только после перезагрузки моего компа к ним получают доступ другие.
Вот программа

автор
Private Sub cmdInputBase_Click()
Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim DBFs As clsDBF
Dim DBFd As clsDBF
Dim Kol_files As Folder
Dim strInputFile$, strOutputFile$, strFieldName$
Dim mmgg$, fName$, ddmmgggg$, NowDate$, t As Variant, n%, i%

NowDate = Replace(CStr(DTPicker1), ".", "")
mmgg = Mid$(NowDate, 3, 2) & Right$(NowDate, 2)
strInputFile = App.Path & "\Output\Prost_Systems" & mmgg & ".dbf"
strOutputFile = App.Path & "\Output\Temp.dbf"
If fso.FileExists(strOutputFile) Then Kill strOutputFile

Set DBFs = New clsDBF
With DBFs
If Not fso.FileExists(strInputFile) Then
If Not .CreateNewFile(strInputFile, 48, 3) Then GoTo Finish
If .CreateField("data", , "C", 10) < 0 Then GoTo Finish
If .CreateField("naim", , "C", 255) < 0 Then GoTo Finish
If .CreateField("mkod1", , "C", 10) < 0 Then GoTo Finish
If .CreateField("mkod2", , "C", 10) < 0 Then GoTo Finish
If .CreateField("mes_ustan", , "C", 255) < 0 Then GoTo Finish
If .CreateField("v_nach", , "C", 6) < 0 Then GoTo Finish
If .CreateField("v_okonch", , "C", 6) < 0 Then GoTo Finish
If .CreateField("v_minuts", , "C", 6) < 0 Then GoTo Finish
If .CreateField("prichProst", , "C", 255) < 0 Then GoTo Finish
If .CreateField("prim", , "C", 255) < 0 Then GoTo Finish
.SaveNewFile
Else
If Not .OpenFile(strInputFile, 3) Then GoTo Finish
Set DBFd = New clsDBF
If Not DBFd.CreateNewFile(strOutputFile, 48, 3) Then GoTo Finish
If DBFd.CreateField("data", , "C", 10) < 0 Then GoTo Finish
If DBFd.CreateField("naim", , "C", 255) < 0 Then GoTo Finish
If DBFd.CreateField("mkod1", , "C", 10) < 0 Then GoTo Finish
If DBFd.CreateField("mkod2", , "C", 10) < 0 Then GoTo Finish
If DBFd.CreateField("mes_ustan", , "C", 255) < 0 Then GoTo Finish
If DBFd.CreateField("v_nach", , "C", 6) < 0 Then GoTo Finish
If DBFd.CreateField("v_okonch", , "C", 6) < 0 Then GoTo Finish
If DBFd.CreateField("v_minuts", , "C", 6) < 0 Then GoTo Finish
If DBFd.CreateField("prichProst", , "C", 255) < 0 Then GoTo Finish
If DBFd.CreateField("prim", , "C", 255) < 0 Then GoTo Finish
Do Until .NoRecord
DBFd.AddNew
If NowDate = .GetFieldValue("data") Then GoTo 1
For i = 0 To .FieldsCount - 1
strFieldName = .GetFieldName(i)
DBFd.SetFieldValue(strFieldName) = .GetFieldValue(i)
Next i
DBFd.Update
1: .MoveNext
Loop
DBFd.SaveNewFile
.CloseFile
DBFd.CloseFile
Set DBFd = Nothing
Kill strInputFile
Name strOutputFile As strInputFile
If Not .OpenFile(strInputFile, 3) Then GoTo Finish
End If
End With

Call CopyInFiles
fName = App.Path & "\Input\"
fn% = Len(fName) + 1
Set Kol_files = fso.GetFolder(fName) ' ôèêñèðîâàíèå ïàïêè ñ âõîäíîé èíôîðìàöèåé.
For Each t In Kol_files.Files
lt% = Len(t)
f$ = UCase(Mid(t, fn%, lt%))
If f$ = "TSAK.XLS" Or f$ = "TSAL.XLS" Or f$ = "TSPD.XLS" Or f$ = "TSSV.XLS" Then
xlApp.EnableEvents = False
Set xlBook = xlApp.Workbooks.Open(t)
xlApp.EnableEvents = True
Set xlSheet = xlBook.Sheets(1)
With xlSheet
ddmmgggg = Trim(.Cells(4, 2)) & Trim(.Cells(4, 3)) & Trim(.Cells(4, 4)) 'äàòà â ñàìîé ñïðàâêå ÄÄÌÌÃÃÃÃ
If NowDate = ddmmgggg Then
n% = 10
Do
If .Cells(n%, 6) <> "" And .Cells(n%, 7) <> "" And .Cells(n%, 8) <> "" Then
DBFs.AddNew
DBFs.SetFieldValue("data") = ddmmgggg
DBFs.SetFieldValue("naim") = .Cells(n%, 2)
DBFs.SetFieldValue("mkod1") = .Cells(n%, 3)
DBFs.SetFieldValue("mkod2") = .Cells(n%, 4)
DBFs.SetFieldValue("mes_ustan") = .Cells(n%, 5)
DBFs.SetFieldValue("v_nach") = .Cells(n%, 6)
DBFs.SetFieldValue("v_okonch") = .Cells(n%, 7)
DBFs.SetFieldValue("v_minuts") = .Cells(n%, 8)
DBFs.SetFieldValue("prichProst") = .Cells(n%, 9)
DBFs.SetFieldValue("prim") = .Cells(n%, 10)
DBFs.Update
End If
n% = n% + 1
Loop Until Trim(.Cells(n% + 4, 2)) = "íå çàïîëíÿòü"
Else
MsgBox "Неверная дата отчета.", vbCritical, "Ошибка!!!"
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
DBFs.CloseFile
GoTo Finish
End If
End With
Set xlSheet = Nothing
Set xlBook = Nothing
End If
Next
xlApp.Quit
Set xlApp = Nothing
DBFs.CloseFile

fName = GetINI(App.Path & "\Set.ini", "Path", "OutputFolder", "")
CopyFile strInputFile, fso.BuildPath(fName, "Prost_Systems" & mmgg & ".dbf"), 0

MsgBox "Процесс завершен успешно.", vbInformation, "Сообщение"
Finish:
Set DBFs = Nothing
End Sub


В программе использую для работы с DBF Модуль Класса Кривцова Аанатолия который скачал здесь на форуме.Модуль хороший спасибо разработчику. Но почему-то при создании полей в таблице если наименование меньше 10 символов он дописывает до 10 символов подставляя в конец символы "_". Почему так и как их убрать может кто знает.

Спасибо за развернутый ответ перед Kill поставил Reset все заработало.
Исправил в модуле:
В функции CheckNewFieldName модуля clsDBF замените выражение:
strFieldNameExt = strFieldNameExt & Space(11 - lngNameLen)
на
strFieldNameExt = strFieldNameExt & String(11 - lngNameLen, vbNullChar)
Тоже все нормально стало в наименовании полей (без "_").

Теперь у меня вопрос по открытым листам Excel. После работы моей программы они не закрываются а остаются в процессах компьютера. И когда я запускаю программу второй раз то уже работаю не сновыми файлами Excel а с теми же которые сидят в процессах. Вроде после работы в программе я все листы и книги закрываю.

автор
....
xlApp.EnableEvents = False
Set xlBook = xlApp.Workbooks.Open(t)
xlApp.EnableEvents = True
Set xlSheet = xlBook.Sheets(1)
With xlSheet
ddmmgggg = Trim(.Cells(4, 2)) & Trim(.Cells(4, 3)) & Trim(.Cells(4, 4))
If NowDate = ddmmgggg Then
n% = 10
Do
If .Cells(n%, 6) <> "" And .Cells(n%, 7) <> "" And .Cells(n%, 8) <> "" Then
DBFs.AddNew
DBFs.SetFieldValue("data") = ddmmgggg
DBFs.SetFieldValue("naim") = .Cells(n%, 2)
DBFs.SetFieldValue("mkod1") = .Cells(n%, 3)
DBFs.SetFieldValue("mkod2") = .Cells(n%, 4)
DBFs.SetFieldValue("mes_ustan") = .Cells(n%, 5)
DBFs.SetFieldValue("v_nach") = .Cells(n%, 6)
DBFs.SetFieldValue("v_okonch") = .Cells(n%, 7)
DBFs.SetFieldValue("v_minuts") = .Cells(n%, 8)
DBFs.SetFieldValue("prichProst") = .Cells(n%, 9)
DBFs.SetFieldValue("prim") = .Cells(n%, 10)
DBFs.Update
End If
n% = n% + 1
Loop Until Trim(.Cells(n% + 4, 2)) = "не заполнять"
Else
MsgBox "Неверная дата отчета.", vbCritical, "Ошибка!!!"
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
DBFs.CloseFile
GoTo Finish
End If
End With
Set xlSheet = Nothing
Set xlBook = Nothing
End If
Next
xlApp.Quit
Set xlApp = Nothing
DBFs.CloseFile
.....


Мне кажется это из-за способа открытия файлов Set xlBook = xlApp.Workbooks.Open(t) я раньше открывал с помощью оператора Set xlBook = GetObject(t) и уменя небыло таких проблем.

vkodorперед
поставь

Спасибо поставил все получилось. Теперь работает нормально.

У меня вопрос к Кривцову Анатолию при работе программы я заметил что с каждям запуском моей программы у меня в выходном dbf файле записей за предыдущие сутки уменьшается на 1. И так при каждом запуске программы пока не исчезнут все прошлые записи и остаются только записи за текущие сутки а мне необходимы все записи (накопительная информация). Ошибка примерно тут но я не могу понять то ли у меня в программе ошибка толи у вас в модуле. Я проверял программа вроде по логике правельна. Попробовал проверить перед
автор


автор


вот участок кода

автор
SRC vba]
..................
If Not .OpenFile(strInputFile, 3) Then GoTo Finish
Set DBFd = New clsDBF
If Not DBFd.CreateNewFile(strOutputFile, 139, 3) Then GoTo Finish
If DBFd.CreateField("data", , "C", 8) < 0 Then GoTo Finish
If DBFd.CreateField("naim", , "C", 255) < 0 Then GoTo Finish
If DBFd.CreateField("mkod1", , "C", 10) < 0 Then GoTo Finish
If DBFd.CreateField("mkod2", , "C", 10) < 0 Then GoTo Finish
If DBFd.CreateField("mes_ustan", , "C", 255) < 0 Then GoTo Finish
If DBFd.CreateField("v_nach", , "C", 6) < 0 Then GoTo Finish
If DBFd.CreateField("v_okonch", , "C", 6) < 0 Then GoTo Finish
If DBFd.CreateField("v_minuts", , "C", 6) < 0 Then GoTo Finish
If DBFd.CreateField("prichProst", , "C", 255) < 0 Then GoTo Finish
If DBFd.CreateField("prim", , "C", 255) < 0 Then GoTo Finish
Do Until .NoRecord
If NowDate = .GetFieldValue("data") Then GoTo 1
DBFd.AddNew
For i = 0 To .FieldsCount - 1
strFieldName = .GetFieldName(i)
DBFd.SetFieldValue(strFieldName) = .GetFieldValue(i)
Next i
DBFd.Update
1: .MoveNext
Loop
........................
[/SRC]