Работа с книгой которая не создана на накопителе

[blackeangel]

Приветствую всех. Подскажите, как работать с книгой, которую не сохранили ещё. В Excel нажали создать книгу, и работают с ней. Теперь надо отработать макрос, но тк макрос работает с книгами которые уже созданы на жёстком диске/накопителе, о выдает ошибку, тк не находит файл.

[Iska]

blackeangel, какой именно макрос?

[blackeangel]

Iska, перенос всего содержимого листа в БД Access. Суть в том что всё падает, на том, если файл открывается из письма почты outlook, то есть путь к файлу как бы есть, но видимо доступа к нему нет. Поэтому и падает. Решил клонированием активной книги в теме, и брать данные из неё. Однако это костыль. Вот и думаю, как взять данные с листа быстро и без обращения к жёсткому диску.

[Iska]

если файл открывается из письма почты outlook, то есть путь к файлу как бы есть »
Не «как бы есть», а точно есть — файл извлекается в каталог временных файлов и оттуда открывается приложением.

Покажите код макроса. Где он хранится. Как вызывается.

[blackeangel]

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

[Iska]

Хранится в надстройке
Вызывается кнопкой надстройки »
В Excel, так?

[blackeangel]

Iska, да, в Excel