| blackeangel |
10-02-2021 08:25 2949540 |
Работа с книгой которая не создана на накопителе
Приветствую всех. Подскажите, как работать с книгой, которую не сохранили ещё. В Excel нажали создать книгу, и работают с ней. Теперь надо отработать макрос, но тк макрос работает с книгами которые уже созданы на жёстком диске/накопителе, о выдает ошибку, тк не находит файл.
|
blackeangel, какой именно макрос?
|
| blackeangel |
10-02-2021 22:05 2949633 |
Iska, перенос всего содержимого листа в БД Access. Суть в том что всё падает, на том, если файл открывается из письма почты outlook, то есть путь к файлу как бы есть, но видимо доступа к нему нет. Поэтому и падает. Решил клонированием активной книги в теме, и брать данные из неё. Однако это костыль. Вот и думаю, как взять данные с листа быстро и без обращения к жёсткому диску.
|
Цитата:
Цитата blackeangel
если файл открывается из письма почты outlook, то есть путь к файлу как бы есть »
|
Не «как бы есть», а точно есть — файл извлекается в каталог временных файлов и оттуда открывается приложением.
Покажите код макроса. Где он хранится. Как вызывается. |
| blackeangel |
11-02-2021 10:59 2949684 |
Iska,
Код:
Sub ExceltoAccessList()
Worktable = CreateObject("WScript.Shell").SpecialFolders("Desktop")
BaseName = Worktable & "\" & ActiveWorkbook.Name & ".mdb"
tmppath = Environ("TEMP")
Select Case CLng(Split(Application.Version, ".")(0))
Case Is < 12
dbConnectStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & BaseName & ";"
Case Is >= 12
dbConnectStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & BaseName & ";"
End Select
On Error Resume Next
Set oAccess = GetObject(, "Access.Application")
Set fso = CreateObject("Scripting.FileSystemObject")
If Err.Number = 429 Then
On Error GoTo 0
If fso.FileExists(BaseName) Then fso.DeleteFile BaseName, True
If fso.FileExists(tmppath & "\" & ActiveWorkbook.Name) Then fso.DeleteFile tmppath & "\" & ActiveWorkbook.Name, True
ActiveWorkbook.SaveCopyAs tmppath & "\" & ActiveWorkbook.Name
Set Catalog = CreateObject("ADOX.Catalog")
Catalog.Create dbConnectStr
Set Catalog = Nothing
Set cnt = New ADODB.Connection
cnt.Open dbConnectStr
sSQL = "SELECT * INTO [" & ActiveSheet.Name & "] FROM [Excel 12.0;HDR=YES;IMEX=1;DATABASE=" & tmppath & "\" & ActiveWorkbook.Name & "].[" & ActiveSheet.Name & "$]"
cnt.Execute sSQL
cnt.Close
Set sAccess = CreateObject("Access.Application")
sAccess.Visible = True
sAccess.UserControl = True
sAccess.OpenCurrentDataBase (BaseName)
Else
basepath = oAccess.CurrentDb.Name
If fso.FileExists(tmppath & "\" & ActiveWorkbook.Name) Then fso.DeleteFile tmppath & "\" & ActiveWorkbook.Name, True
ActiveWorkbook.SaveCopyAs tmppath & "\" & ActiveWorkbook.Name
If Err.Number = 91 Then
On Error GoTo 0
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(BaseName) Then fso.DeleteFile BaseName, True
Set Catalog = CreateObject("ADOX.Catalog")
Catalog.Create dbConnectStr
Set Catalog = Nothing
Set oAccess = GetObject(, "Access.Application")
oAccess.OpenCurrentDataBase (BaseName)
End If
On Error GoTo 0
oAccess.CurrentProject.Connection.Execute "SELECT * INTO [" & ActiveSheet.Name & "] FROM [Excel 12.0;HDR=YES;IMEX=1;DATABASE=" & tmppath & "\" & ActiveWorkbook.Name & "].[" & ActiveSheet.Name & "$]"
oAccess.RefreshDataBaseWindow
End If
If fso.FileExists(tmppath & "\" & ActiveWorkbook.Name) Then fso.DeleteFile tmppath & "\" & ActiveWorkbook.Name, True
End Sub
Хранится в надстройке
Вызывается кнопкой надстройки
Ошибка в строке
SELECT * INTO [" & ActiveSheet.Name & "] FROM [Excel 12.0;HDR=YES;IMEX=1;DATABASE=" & tmppath & "\" & ActiveWorkbook.Name & "].[" & ActiveSheet.Name & "$]"
Текст ошибки примерно такой - лист2$ недопустимое имя. Назовите по другому или убедитесь что оно есть.
Если файл из почты сохранить в другое место, всё работает без проблем. Но, тк это правленый вариант, то этой ошибки вы не увидите.
Ошибка была когда вместо tmppath & "\" & ActiveWorkbook.Name было ActiveWorkbook.FullName
|
Цитата:
Цитата blackeangel
Хранится в надстройке
Вызывается кнопкой надстройки »
|
В Excel, так? |
| blackeangel |
11-02-2021 17:24 2949748 |
Iska, да, в Excel
|
Время: 22:46.
© OSzone.net 2001-
