Страница: 1 |
Вопрос: Не могу записать текстовый файл в Excel | Добавлено: 17.05.06 18:48 |
Автор вопроса: ![]() |
Стандартный VB-VBA-код создания и открытия файла
Open "d:\bb" For Output As #1 Print #1, w Close #1 вызывает в VBA-коде Excel непреодолимые трудности - File not found. Не помогает изменение на For Append а также обращение к FileSystem Object: Dim fs, a Set fs = CreateObject("Scripting.FileSystemObject") Set a = fs.CreateTextFile(ActiveWorkbook.Path + "\test.txt", True) - валится на оп CreateTextFile ---------------------------- Может дело в порядке библиотек в References? 1 - VB for Application 2 -Ms Excel 10.0 Objext Library 3- MS Forms 2.0 Object Library 4 - MS Office 10.0 Object Library |
Ответы | Всего ответов: 7 |
Номер ответа: 1 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ICQ: 247906854 Вопросов: 133 Ответов: 882 |
Web-сайт: Профиль | Цитата | #1 | Добавлено: 17.05.06 19:07 |
Стганно...
Офис, переставлять пробовал? А через API работает? |
Номер ответа: 2 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() Вопросов: 6 Ответов: 8 |
Профиль | Цитата | #2 | Добавлено: 17.05.06 19:13 |
Переставил щфис с 2003 на XP - то же самое.
Через API не умею, научите. Самое интересное проходит такой оператор Open "c:\aa.txt" for binary AS #1 (заковырялся на Print #1,w) |
Номер ответа: 3 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ICQ: 247906854 Вопросов: 133 Ответов: 882 |
Web-сайт: Профиль | Цитата | #3 | Добавлено: 17.05.06 19:35 |
Private Declare Function OpenFile Lib "kernel32.dll" (ByVal lpFileName As String, ByRef lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long Private Declare Function WriteFile Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, ByRef lpNumberOfBytesWritten As Long, ByRef lpOverlapped As OVERLAPPED) As Long Private Type OVERLAPPED ternal As Long ternalHigh As Long offset As Long OffsetHigh As Long hEvent As Long End Type Private Declare Function ReadFile Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, ByRef lpNumberOfBytesRead As Long, ByRef lpOverlapped As OVERLAPPED) As Long Private Function OpenFiles() As Boolean ' îòêðûâàþ ôàéëû, çàïóñêàþ òàéìåð Dim ofsFrom As OFSTRUCT, ofsTo As OFSTRUCT boolBusy = True hFileFrom = OpenFile(strFromFileName, ofsFrom, OF_READ + OF_SHARE_DENY_WRITE) hFileTo = OpenFile(strToFileName, ofsTo, OF_WRITE + OF_SHARE_EXCLUSIVE + OF_CREATE) If ofsFrom.nErrCode = 0 And (ofsTo.nErrCode = 0 Or ofsTo.nErrCode = 183) Then lngSourceFileSize = FileLen(strFromFileName) lngCopyPlace = 0: lngTotalBytesCopied = 0: ReDim arrBuf(lngPackSize) tmrCopy.Enabled = True OpenFiles = True arrTask(lngCurTaskIndex).lngResult = 1 PrepareProc SetNewTimes UpdateList Else lngErrorCount = lngErrorCount + 1 ShowErr ofsTo.nErrCode, "---" arrTask(lngCurTaskIndex).lngResult = 3 arrTask(lngCurTaskIndex).strErrorDescription = "Îøèáêà ïðè îòêðûòèèè ôàéëà" CloseHandle hFileFrom CloseHandle hFileTo boolBusy = False UpdateList NextTask End If End Function Private Sub tmrCopy_Timer() ' êîïèðóþ, ïîêà íå ñêîïèðóþ, çàïóñêàþ çàêðûòèå If boolBusy Then Dim nErr As Long, lngBytesToCopy As Long, lngBytesCopied As Long ovlFrom.offset = lngCopyPlace: lngBytesToCopy = lngPackSize nErr = ReadFileArr(hFileFrom, arrBuf(0), lngBytesToCopy, lngBytesCopied, ovlFrom) If nErr = 1 Then ' And lngBytesCopied = lngBytesToCopy ovlTo.offset = lngCopyPlace lngBytesToCopy = lngBytesCopied nErr = WriteFileArr(hFileTo, arrBuf(0), lngBytesToCopy, lngBytesCopied, ovlTo) If nErr = 1 And lngBytesCopied = lngBytesToCopy Then lngCopyPlace = lngCopyPlace + lngPackSize lngTotalBytesCopied = lngTotalBytesCopied + lngBytesCopied ' ReDim arrBuf(lngPackSize) ShowProc Else Dim answer As Long answer = MyMsgBox("Âî âðåìÿ âûïîëíåíèÿ îïåðàöèè âîçíèêëà îøèáêà:" + vbCrLf + vbCrLf + GetErrorText(GetLastError) + vbCrLf + vbCrLf + "×òî æåëàåòå ïðåäïðèíÿòü?", _ "Ïðîäîëæèòü âûïîëíåíèå - ÿ èñïðàâèë ïðîáëåìó.|Ïðåðâàòü âûïîëíåíèå ýòîé çàäà÷è.|Ïðåðâàòü âûïîëíåíèå âñåõ çàäà÷.", 2, "Îøèáêà: " + CStr(GetLastError)) Select Case answer Case 0: 'Ïðîäîëæàþ...." Case 1: AbortTask False Case 2: AbortTask True End Select Debug.Print "Âîçíèêëà îøèáêà ïðè çàïèñè" Beep End If Else If lngSourceFileSize = lngTotalBytesCopied Then Debug.Print "Ñêîïèðîâàíî" CloseFiles Else AbortTask False Debug.Print "Âîçíèêëà îøèáêà ïðè ÷òåíèè" Beep End If End If UpdateTimes End If End Sub Private Function CloseFiles() As Boolean ' çàêðûâàþ ôàéëû, âûêëþ÷àþ òàéìåð, åñëè íàäî óäàëÿþ èñòî÷íèê, ' ïåðåêëþ÷àþñü íà ñëåäóþùåå çàäàíèå Dim nErr As Long, lngTryCount, chkRez As Boolean CloseHandle hFileFrom CloseHandle hFileTo tmrCopy.Enabled = False boolBusy = False ' ïîñëå çàêðûòèÿ ôàéëîâ, íî äî âûçîâà NextTask If boolNeedCheck Then chkRez = IsOk(strFromFileName, strToFileName) Else chkRez = True If chkRez Then If arrTask(lngCurTaskIndex).lngAction = 2 Then Do nErr = DeleteFile(strFromFileName) lngTryCount = lngTryCount + 1 Sleep lngTryCount * 5 If lngTryCount > 50 Then CloseHandle hFileFrom: CloseHandle hFileTo Loop While nErr <> 1 And lngTryCount < 100 If nErr <> 1 Then arrTask(lngCurTaskIndex).lngResult = 3 arrTask(lngCurTaskIndex).strErrorDescription = "Íå óäàëîñü óäàëèòü ôàéë ïîñëå êîïèðîâàíèÿ" End If End If If nErr = 0 Then arrTask(lngCurTaskIndex).lngResult = 2 Else With arrTask(lngCurTaskIndex) If .lngResult = 4 Then .strDetails = "Ïðåðâàíî ïîëüçîâàòåëåì" Else .lngResult = 3 .strErrorDescription = "Èñõîäíûé è êîíå÷íûé ôàéëû íåîäèíàêîâû" End If End With End If UpdateList NextTask End Function Здесь всё, что надо есть - только вырвано из старого проекта и у тебя работать не будет. Может у тебя там с правами что-нить? Ручками те же файлы создаются? |
Номер ответа: 4 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() Вопросов: 6 Ответов: 8 |
Профиль | Цитата | #4 | Добавлено: 18.05.06 12:50 |
С правами нормально и руками могу создать. Не поленился пошёл испытывать в компьют класс - из 6 компов на трёх - создает файл, на остальных - выдаёт ту же ош 53 - File not Found на Open File for Output
Все компы - одной разливки, WinXP+Ms Office 2003 Права все одинаковые. На что думпть? Может какой Service Pack или что-то вроде? |
Номер ответа: 5 Автор ответа: ![]() ![]() ![]() ICQ: 26977559 Вопросов: 4 Ответов: 18 |
Профиль | Цитата | #5 | Добавлено: 18.05.06 18:53 |
А если так:
dim ff as long ff = freefile open "FileName.txt" for output as ff print #ff, myvar close(ff) |
Номер ответа: 6 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() Вопросов: 6 Ответов: 8 |
Профиль | Цитата | #6 | Добавлено: 19.05.06 13:28 |
Пробовал и так - всё равно не помогает
Видно дело в особенностях установки системы, офиса, может каких-то библиотек |
Номер ответа: 7 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() Вопросов: 6 Ответов: 8 |
Профиль | Цитата | #7 | Добавлено: 19.05.06 13:41 |
Может кто из читающих этот топик работает в фирме имеющей право на техподдержку мелкософта.
Не затруднит ли его переадресовать сей вопрос его представителям? |
Страница: 1 |
|