ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Сохранение файла из Excel
4 сообщений из 4, страница 1 из 1
Сохранение файла из Excel
    #34844345
Фотография SergeySV
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SergeySV
Участник
Мне надо перенести вместе с файлом xls другие текстовые (и нетекстовые) файлы (это не вирус сразу говорю).

Добавлять их файл-xls я могу:
Worksheets(1).OLEObjects.Add Link:=False, DisplayAsIcon:=False,fileName:="C:\1.txt"

Проблема, как их потом из Excel достать и сохранить на локальном диске программным путем. Готовых методов сохранить нет, есть токо копировать, вырезать, дублировать. Так, руками, я просто копирую в буфер олеобъект и вставляю где-нибудь в окне Exploera, а вот программно как? тоже через буфер обмена (через winApi) или есть что-нибудь более гуманное?
...
Рейтинг: 0 / 0
03.10.2007, 15:54:14
| Ответить | Цитировать | Написать  
Сохранение файла из Excel
    #34848944
Фотография SergeySV
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SergeySV
Участник
для тындекса: внедрение объектов в Excel Insert – Object - Create from File как сохранить файл на диск

Как я подозревал, с этой проблемой столкнулся не я один и что главное - не первый. Вот сообщение нашего соотечественника, который провел подробные исследования и написал работающую функцию для частного случая.
http://forum.ixbt.com/topic.cgi?id=23:29135-3

Я доработал эту функцию для использования с любым файлом и выкладываю ее здесь:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
Option Explicit

' --- FUNCTIONS ---
' Clipboard functions
Private Declare Function OpenClipboard Lib "USER32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "USER32" () As Long
Private Declare Function GetClipboardData Lib "USER32" (ByVal wFormat As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "USER32" (ByVal wFormat As Long) As Long
 
' Memory functions
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
 
' Files functions
Private Declare Function CreateFile Lib "kernel32" _
Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
 
Private Declare Function WriteFile Lib "kernel32" _
(ByVal hFile As Long, _
lpBuffer As Any, _
ByVal nNumberOfBytesToWrite As Long, _
lpNumberOfBytesWritten As Long, _
ByVal lpOverlapped As Any) As Long
 
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long 'close file
' --- ---
 
' --- CONSTANTS ---
Private Const GENERIC_WRITE = &H40000000
Private Const CREATE_ALWAYS =  2 
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2

Private Const CF_Native =  49156  ' Формат который называется - Native
Private Const EmbEOB =  2  ' скопир. в буфер обмена файл в конце ограничив. 2 нулевыми байтами
  


Public Function ClipboardGetFilesFromXls(sPath As String, Optional sNameFile As String = "") As Boolean
    ' Функция сохраняет скопированный в clipboard из Excel файл-объект на диск.
    ' скопированный файл в clipboard должен быть один.
    ' Возвращает: True - в случае успешной записи файла на диск; False - при возникновении ошибки
    '[sPath]     - путь для сохранения (должен заканчиваться обяз. - "\")
    '[sNameFile] - имя файла для сохранения, если пропущено, то берется имя файла из clipboard'а
    
    Dim CBBlockLength As Long, BytesWritten As Long
    Dim i As Integer
    Dim p As Long  ' pointer
    Dim hM As Long ' handle (clipboard - native)
    Dim hF As Long ' handle (file)
    Dim sName As String
    Dim sBuffer As String
    Dim l As Long
    Dim sNameFileIsx As String ' исходное имя скопированного файла, которое содержится в clipboard'е
        
    On Error GoTo Er_
        
    ' Insure desired format is there, and open clipboard.
    If IsClipboardFormatAvailable(CF_Native) Then
        If OpenClipboard( 0 &) Then
              'Получаем указатель на данные из clipboard
              hM = GetClipboardData(CF_Native)
              If hM >  0  Then
                CBBlockLength = GlobalSize(hM) ' Размер области памяти
                If CBBlockLength >  0  Then
                  p = GlobalLock(hM)
                  If p >  0  Then
                    ' считываем первые 256 символов, чтобы проанализовать их
                    ' и определить размер заголовка - формата Native
                    ' Заголовок имеет такой вид:
                    ' 20[имя файла]0[полн. имя файла]0________[полн. имя файла]0[размер файла 4 байт][содержание самого файла][00]
                    If CBBlockLength <  256  Then
                       sBuffer = String$(CBBlockLength,  0 )
                    Else
                       sBuffer = String$( 256 ,  0 )
                    End If
                    Call CopyMem(ByVal sBuffer, ByVal p, Len(sBuffer))
                    l = InStr( 3 , sBuffer, vbNullChar)
                    If l >  0  Then
                       sNameFileIsx = "'" & Mid(sBuffer,  3 , l -  3 ) & "'"
                       l = InStr(l +  1 , sBuffer, vbNullChar)
                       If l >  0  Then
                          l = InStr(l +  9 , sBuffer, vbNullChar)
                          If l >  0  Then
                             l = l +  4 
                          Else
                             l =  0 
                          End If
                       End If
                    End If
                    
                    If l <>  0  Then
                       ' определяем нужную нам область памяти
                       p = p + l ' начал. смещение в памяти
                       CBBlockLength = CBBlockLength - l - EmbEOB ' размер области памяти
                        
                       ' Создаем файл
                       If Len(sNameFile) =  0  Then
                           sName = sNameFileIsx
                        Else
                           sName = sNameFile
                        End If
                       If Len(Dir(sPath & sName)) <>  0  Then
                          Kill (sPath & sName)
                       End If
                       hF = CreateFile(sName, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal  0 &, CREATE_ALWAYS,  0 ,  0 )
                        
                       ' пишем в файл
                       Call WriteFile(hF, ByVal p, CBBlockLength, BytesWritten, ByVal  0 &)
                       If BytesWritten >  0  Then ClipboardGetFilesFromXls = True
                    End If
                  End If
                  Call GlobalUnlock(hM)
                End If
              End If
              
              CloseHandle (hF) ' close file
              CloseClipboard
        End If
    End If
    
    
Ex_:
   Exit Function
   
Er_:
  ClipboardGetFilesFromXls = False
  Resume Ex_
    
End Function

P.S. Несколько замечаний на последок: Функция работает только для одного скопированного файла в буфер обмена, в случае скопированных несколько файлов формат - Native не поддерживается (соответ. функция ничего не сделает). Виндузовский проводник тоже непонимает такой формат и вставлять несколько скопированных файлов отказывается.
...
Рейтинг: 0 / 0
05.10.2007, 11:16:29
| Ответить | Цитировать | Написать  
Сохранение файла из Excel
    #34850162
Фотография SergeySV
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SergeySV
Участник
Тьфу, забыл в коде отладочную строку, щас поправил.

для тындекса: внедрение объектов в Excel Insert – Object - Create from File как сохранить файл на диск

Как я подозревал, с этой проблемой столкнулся не я один и что главное - не первый. Вот сообщение нашего соотечественника, который провел подробные исследования и написал работающую функцию для частного случая.
http://forum.ixbt.com/topic.cgi?id=23:29135-3

Я доработал эту функцию для использования с любым файлом и выкладываю ее здесь:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
Option Explicit

' --- FUNCTIONS ---
' Clipboard functions
Private Declare Function OpenClipboard Lib "USER32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "USER32" () As Long
Private Declare Function GetClipboardData Lib "USER32" (ByVal wFormat As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "USER32" (ByVal wFormat As Long) As Long
 
' Memory functions
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
 
' Files functions
Private Declare Function CreateFile Lib "kernel32" _
Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
 
Private Declare Function WriteFile Lib "kernel32" _
(ByVal hFile As Long, _
lpBuffer As Any, _
ByVal nNumberOfBytesToWrite As Long, _
lpNumberOfBytesWritten As Long, _
ByVal lpOverlapped As Any) As Long
 
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long 'close file
' --- ---
 
' --- CONSTANTS ---
Private Const GENERIC_WRITE = &H40000000
Private Const CREATE_ALWAYS =  2 
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2

Private Const CF_Native =  49156  ' Формат который называется - Native
Private Const EmbEOB =  2  ' скопир. в буфер обмена файл в конце ограничив. 2 нулевыми байтами
  


Public Function ClipboardGetFilesFromXls(sPath As String, Optional sNameFile As String = "") As Boolean
    ' Функция сохраняет скопированный в clipboard из Excel файл-объект на диск.
    ' скопированный файл в clipboard должен быть один.
    ' Возвращает: True - в случае успешной записи файла на диск; False - при возникновении ошибки
    '[sPath]     - путь для сохранения (должен заканчиваться обяз. - "\")
    '[sNameFile] - имя файла для сохранения, если пропущено, то берется имя файла из clipboard'а
    
    Dim CBBlockLength As Long, BytesWritten As Long
    Dim i As Integer
    Dim p As Long  ' pointer
    Dim hM As Long ' handle (clipboard - native)
    Dim hF As Long ' handle (file)
    Dim sName As String
    Dim sBuffer As String
    Dim l As Long
    Dim sNameFileIsx As String ' исходное имя скопированного файла, которое содержится в clipboard'е
        
    On Error GoTo Er_
        
    ' Insure desired format is there, and open clipboard.
    If IsClipboardFormatAvailable(CF_Native) Then
        If OpenClipboard( 0 &) Then
              'Получаем указатель на данные из clipboard
              hM = GetClipboardData(CF_Native)
              If hM >  0  Then
                CBBlockLength = GlobalSize(hM) ' Размер области памяти
                If CBBlockLength >  0  Then
                  p = GlobalLock(hM)
                  If p >  0  Then
                    ' считываем первые 256 символов, чтобы проанализовать их
                    ' и определить размер заголовка - формата Native
                    ' Заголовок имеет такой вид:
                    ' 20[имя файла]0[полн. имя файла]0________[полн. имя файла]0[размер файла 4 байт][содержание самого файла][00]
                    If CBBlockLength <  256  Then
                       sBuffer = String$(CBBlockLength,  0 )
                    Else
                       sBuffer = String$( 256 ,  0 )
                    End If
                    Call CopyMem(ByVal sBuffer, ByVal p, Len(sBuffer))
                    l = InStr( 3 , sBuffer, vbNullChar)
                    If l >  0  Then
                       sNameFileIsx = Mid(sBuffer,  3 , l -  3 )
                       l = InStr(l +  1 , sBuffer, vbNullChar)
                       If l >  0  Then
                          l = InStr(l +  9 , sBuffer, vbNullChar)
                          If l >  0  Then
                             l = l +  4 
                          Else
                             l =  0 
                          End If
                       End If
                    End If
                    
                    If l <>  0  Then
                       ' определяем нужную нам область памяти
                       p = p + l ' начал. смещение в памяти
                       CBBlockLength = CBBlockLength - l - EmbEOB ' размер области памяти
                        
                       ' Создаем файл
                       If Len(sNameFile) =  0  Then
                           sName = sNameFileIsx
                        Else
                           sName = sNameFile
                        End If
                       If Len(Dir(sPath & sName)) <>  0  Then
                          Kill (sPath & sName)
                       End If
                       hF = CreateFile(sName, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal  0 &, CREATE_ALWAYS,  0 ,  0 )
                        
                       ' пишем в файл
                       Call WriteFile(hF, ByVal p, CBBlockLength, BytesWritten, ByVal  0 &)
                       If BytesWritten >  0  Then ClipboardGetFilesFromXls = True
                    End If
                  End If
                  Call GlobalUnlock(hM)
                End If
              End If
              
              CloseHandle (hF) ' close file
              CloseClipboard
        End If
    End If
    
    
Ex_:
   Exit Function
   
Er_:
  ClipboardGetFilesFromXls = False
  Resume Ex_
    
End Function

P.S. Несколько замечаний на последок: Функция работает только для одного скопированного файла в буфер обмена, в случае скопированных несколько файлов формат - Native не поддерживается (соответ. функция ничего не сделает). Виндузовский проводник тоже непонимает такой формат и вставлять несколько скопированных файлов отказывается.
...
Рейтинг: 0 / 0
05.10.2007, 15:01:21
| Ответить | Цитировать | Написать  
Сохранение файла из Excel
    #34850307
Фотография SergeySV
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SergeySV
Участник
Вот эту строку тоже переправьте hF = CreateFile( sName , GENERIC_WRITE, FIL......
на hF = CreateFile( sPath & sName , GENERIC_WRITE, FIL
...
Рейтинг: 0 / 0
05.10.2007, 15:31:59
| Ответить | Цитировать | Написать  
4 сообщений из 4, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Сохранение файла из Excel
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=61&msg=34844345&tid=2182149]:
 0ms
get settings:
 10ms
get forum list:
 18ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 68ms
get topic data:
 14ms
get forum data:
 3ms
get page messages:
 49ms
get tp. blocked users:
 2ms
others: 235ms
total:  407ms
созд. / загр.: 407ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]