Прикрепление и извлечение различных файлов из книги Excel

Скажите пожалуйста, если выбрать кнопку "извлечь и запустить выделенный файл" (например, приложение exe), то он после извлечения и запуска остается во временной папке? и как файл запускается повторно, переписывается во временной папке или затирается по имени и извлекается снова? Спасибо!

В продолжение вопроса синхронизации, накувыркал, может кому пригодится. Без imp1exp2 - в обе стороны. Если imp1exp2 = 1 - только импорт, если данные разнятся. Если imp1exp2 = 2 - только экспорт, если разнятся. В коде заменить FileRange.Cells(2) = Now на FileRange.Cells(2) = FileDateTime(filepath$)

Public Sub СинхронизацияВложения(ByVal sFile As String, Optional imp1exp2 As Byte)
Dim FM As New AttachedFiles
Dim objShell As Object, objItem As Object
Dim sName As String: sName = Right(sFile, Len(sFile) - InStrRev(sFile, "\"))
Dim isRO As Boolean

If Not PathExistsR(sFile) Then
If imp1exp2 <> 1 Then
On Error Resume Next
FM.GetAttachment(sName).SaveAs sFile
If Err Then Debug.Print "Отсутствует вложение " & sName & ". И не найден файл " & sFile: Exit Sub
Err.Clear
Set objShell = CreateObject("Shell.Application")
Debug.Print "FileDateTime" & FileDateTime(sFile)
For Each objItem In objShell.Namespace(Left(sFile, InStrRev(sFile, "\") - 1)).Items
If objItem.Name = sName Then objItem.ModifyDate = FM.GetAttachment(sName).AttachDate
Next
Debug.Print "FileDateTime" & FileDateTime(sFile)
Debug.Print "AttachDate" & FM.GetAttachment(sName).AttachDate
Debug.Print "Файл " & sFile & " отсутствует. Экспорт вложения."
End If
ElseIf FM.AttachmentExist(sName) Then
If FileDateTime(sFile) < FM.GetAttachment(sName).AttachDate Then
isRO = GetAttr(sFile) And vbReadOnly
If isRO Then SetAttr sFile, GetAttr(sFile) - vbReadOnly
If imp1exp2 <> 1 Then FM.GetAttachment(sName).SaveAs sFile: Debug.Print "Файл " & sFile & " устарел. Экспорт вложения."
If isRO Then SetAttr sFile, GetAttr(sFile) + vbReadOnly
ElseIf FileDateTime(sFile) > FM.GetAttachment(sName).AttachDate Then
If imp1exp2 <> 2 Then FM.AttachNewFile sFile: Debug.Print "Файл " & sFile & " новее. Импорт файла."
End If
Else
If imp1exp2 <> 2 Then FM.AttachNewFile sFile: Debug.Print "Отсутствует вложение " & sFile & ". Импорт файла."
End If
End Sub

где
Public Function PathExistsR(pname As String) As Boolean
On Error Resume Next
PathExistsR = GetAttr(pname) And vbDirectory = vbDirectory
End Function

Впрочем я брюзжу. Достаточно изменить в коде FileRange.Cells(2) = Now на FileRange.Cells(2) = FileDateTime(filepath$)

Вопреки описанию, свойство AttachDate недоступно для записи. Жалко, потому как это не позволит реализовать синхронизацию вложение-файл, сверяя AttachDate и FileDateTime соответственно - неизвестно какая исходная дата/время у вложения - только время импорта (а зачем оно вообще нужно...).

Тоже самое.
Из выделенных ячеек открывает только последний файл из выделенного диапазона.
Думал, может я наворотил чего с кодом - скачал с сайта заново файл (AttachFiles.xlsb - файл с модулями класса и примерами работы со вложенными файлами) и запустил ваш макрос.
Все равно открывает только один последний файл.

Спасибо большое, разобрался.
Не получается сделать тоже самое для открытия файлов.
Подскажите, что не так?

Sub Запустить_Выбранный_Файл()

Dim cell As Range, SelectionCell As Range
On Error Resume Next
Set SelectionCell = Intersect(Selection, ActiveSheet.UsedRange) ' выделенный диапазон
If SelectionCell Is Nothing Then Exit Sub
' создаём объект FileManager типа AttachedFiles
Dim FileManager As New AttachedFiles, File As AttachedFile, res As Boolean
For Each cell In SelectionCell ' перебираем ячейки в выделенном диапазоне
' Filename$ = SelectedAttachment
Filename$ = cell.Value ' имя файла из ячейки
If Filename$ = "" Then Exit Sub 'получаем имя файла-вложения из выделенной строки листа
If Not FileManager.AttachmentExist(Filename$) Then
MsgBox "Вложение с именем «" & Filename$ & "» не найдено в текущей книге Excel", vbCritical, "Ошибка"
Exit Sub
End If
' вызываем метод GetAttachment с параметром - именем извлекаемого файла
' метод GetAttachment возвращает объект типа AttachedFile
' И к этому объекту типа AttachedFile мы применяем метод Run (для запуска файла)
FileManager.GetAttachment(Filename$).Run
Next
End Sub

Добрый день.
А подскажите, как прикреплять к файлу сразу несколько файлов, а не выбирать по одному?

Public Declare PtrSafe Function GetTickCount Lib "kernel32.dll" () As Long

'Intel Core i7 920 2.67 GHz, 6Gb ОЗУ, Windows 7 Максимальная, x64, SP 1
'почувствуйте разницу между конкатенацией и прямой адресацией
Sub SpeedTest()
Dim sFix As String * MAX_STR_SIZE ' = 65526
Dim sFlt As String
Dim lI, lTime As Long

'прямая адресация
lTime = GetTickCount
For k = 1 To 10
sFix = ""
For lI = 1 To MAX_STR_SIZE
Mid(sFix, lI, 1) = "*"
Next lI 'дает 0 мс
Next k
Debug.Print GetTickCount - lTime 'дает 16 мс

'конкатенация
lTime = GetTickCount
For k = 1 To 10
sFlt = ""
For lI = 1 To MAX_STR_SIZE
sFlt = sFlt & "*"
Next lI 'дает в среднем 374 мс
Next k
Debug.Print GetTickCount - lTime 'дает в среднем 3760 мс - БЕДА... ;-(

End Sub

Это к предыдущему сообщению...

Здравствуйте Игорь.
Очень понравилась Ваша идея прикрепления файлов. Просто супер! Правда хотел кое-что посоветовать Вам.
1. Все операции конкатенации строк очень процессоемкие. Каждая операция конкатенации влечет за собой перераспределение и копирование памяти, что требует много ресурсов. На небольших объемах это не очень заметно, а при больших... Лучше их заменить на работу со строками фиксированной длинны и делать преобразования из бинари в хекс и обратно - блоками - будет все на много быстрее работать.
2. Условные блоки по SilentMode "запихнуты" во внутрь вычислений, которые "завязаны" на SilentMode - это не совсем правильно. Вычисления и формирование информации должно делаться только если Not SilentMode, чтобы зря не делать лишнюю работу...

Это все на Ваше усмотрение.
Чтобы не быть голословным делюсь двумя функциями блочного преобразования (м.б. пригодятся)

Public Const MAX_STR_SIZE = 65526
Public Const MAX_BIN_SIZE = 32763

'преобразование строки содержащей символы 16ричных значений в двоичную строку
'БЕЗ ИСПОЛЬЗОВАНИЯ КОНКАТЕНАЦИИ СТРОК
'максимальный размер (длина) sHexStr - MAX_STR_SIZE = 65526
'sHexStr - содержит 16ричные значения
Function fnHexStrToBinStr(ByVal sHexStr As String) As String
Dim sRet As String, lI As Long, sTmp As String * 4, lSz As Long

lSz = Len(sHexStr) / 2: lSz = IIf(lSz > MAX_BIN_SIZE, MAX_BIN_SIZE, lSz)
sRet = String(lSz, Chr(0))

sTmp = "&H"

For lI = 1 To lSz
Mid(sTmp, 3) = Mid(sHexStr, (lI - 1) * 2 + 1, 2)
Mid(sRet, lI, 1) = Chr(Val(sTmp))
Next lI

fnHexStrToBinStr = sRet
End Function

'преобразование строки содержащей двоичный код в символьную строку 16ричных значений
'БЕЗ ИСПОЛЬЗОВАНИЯ КОНКАТЕНАЦИИ СТРОК
'максимальный размер (длина) sBinStr - MAX_BIN_SIZE = 32763
'sBinStr - содержит двоичные значения
Function fnBinStrToHexStr(ByVal sBinStr As String) As String
Dim sRet As String, lI As Long, iC As Integer, lSz As Long
Dim sHtmp As String, sTmp As String * 2

lSz = Len(sBinStr): lSz = IIf(lSz > MAX_BIN_SIZE, MAX_BIN_SIZE, lSz)
sRet = String(lSz * 2, Chr(0))

For lI = 1 To Len(sBinStr)
iC = Asc(Mid(sBinStr, lI, 1))
sHtmp = Hex(iC)
sTmp = "00": Mid(sTmp, 3 - Len(sHtmp)) = sHtmp
Mid(sRet, (lI - 1) * 2 + 1, 2) = sTmp
Next lI

fnBinStrToHexStr = sRet
End Function

а кодировщиках мне известно. сижу перекодирую. просто хотел готовый код в существующий код интегрировать.

спасибо, кодовую страницу изменять нельзя.
работаю с языками в алфавит которых входят особенные символы. турецкий, норвержский, польский, чешский.. и т.д. и немецкий.
немецкая ос более толерантна к таким шрифтам.

' îáíîâëÿåì äàííûå â òàáëèöå (íåîáÿçàòåëüíî, èñêëþ÷èòåëüíî äëÿ íàãëÿäíîñòè)
Âûâåñòè_â_Òàáëèöó_Ñâåäåíèÿ_î_Ïðèêðåïë¸ííûõ_Ôàéëàõ
End Sub()

что написано перед End Sub после комментария?
это функция выбора файла для 2003 екселя.

как без кириллицы? я привел пример с кракозяблами. имя подпрограммы.
я бы заменил все на латиницу, но поиск по кракозяблам не работает.
не понимаю применение кириллицы в программном коде.

есть ли возможность комментарии к прикрепляемому файлу на тот же лист, как служебную информацию заносить? или первую ячейку столбца для этого использовать? пару намеков бы. а то пока разберусь, как код работает, без комментарий не так быстро будет.
сейчас видится только, как параллельная привязка информации размещаемой на другом листе.

нет ли в наличии подобных макросов без применения кириллицы в коде?
Sub ÏðèêðåïèòüÔàéë() ' ïðèêðåïëÿåì ôàéë ê êíèãå Excel
я не о комментариях.

на немецкой ОС после попытки выполнить действия кликом на псевдокнопку-ошибка... не найден макрос.

Здравствуйте.
Макрос работает отлично. Спасибо большое за вашу разработку.

Подскажите. Можно ли прикреплять файл не из конктретного файла на диске, а из диаграммы excel?
Просто сейчас я нужную мне диаграмму с помощью другого вашего макроса сохраняю на диск как рисунок и только потом прикрепляю полученный файл с помощью макроса FileManager. Возможно ли нужную мне диагрумму сразу преобразовывать в байты (минуя этап сохранения на компьютер)?

Здравствуйте Игорь.
Я писал Вам по поводу работоспособности в 2003 office, исправив на 120 всё работает, но только в системе Windows XP, а на Windows 7 не работает не в 2003, не 2007.
Посмотрев во временную папку там создаётся прикреплённый файл, но имеет размер 0 байт.
С чем это связано?
С уважением Иван.

Здравствуйте Игорь!
При загрузке файла в excel 2010 и последующем запуске на выполнение всё работает корректно, но запуск этого же файла в excel 2003 распаковывает файл во временную директорию и при попытке запуска вручную (автоматически не работает) пишет: "это приложение не является win 32" что может означать что испорчена сигнатура.
Макросы которые доступны на этой странице предназначены для 2010 версии Excel?
Иван.

Спасибо за Ваши очень полезные разработки.

Уважаемый Игорь, у вас замечательный сайт и много полезной информации.
Пользуюсь вашими примерами, подскажите, а можно ли хранить файлы подобным способом в ACCESS? моих знаний в WinApi - не хватает, чтобы переписать код...

Спасибо за ответ!

спасибо, это возможно выход! таки может получиться..."в обратку")

У меня задача "наделить" простые книги.xls ...формочками с макросами, (на входе файл без формы, на выходе файл с формой и макросом к форме) ...а хранить код в надстройке я и сам понимаю, не в этом задача...как форму в другой файл вогнать вот задача.

именно в этом и задача. как импортировать форму в файл, чтобы потом прицепить к форме макрос. ...просто много будет этих форм и файлов, в ручную ...грусно будет очень.

а вот такой вопрос: можно ли программным путем включить с соствав рабочей книги excel oбъект userform , ранее сохраненный в виде файла userform.frm ?

Скажите пожалуйста. Файлы прикрепляются все, но они все повреждены(так указывает примечание на листе)
поэтому прикрепленные файлы не извлекаются...
И на скрытом листе бинарный код записывается.
В чем может быть причина ошибки?

У меня avast ругается на ConnectionsInformation.exe...
А так всё работает, спасибо.
И красиво! :)