Сохранение Excel-файла через макрос VBA в Access

@BSH · Регистрация: 20.04.2016

Author24 — интернет-сервис помощи студентам

Добрый день.
полная информация есть здесь:Сохранение excel файла через макрос access
подскажите если сможете, при сохранении файла exsel сначала открывается пустой файл и сохраняется, а нужный просто закрывается:

Visual Basic

Sub test()
 
' открытие сап
 
If Not IsObject(Appl) Then
   Set SapGuiAuto = GetObject("SAPGUI")
   Set Appl = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(Connection) Then
   Set Connection = Appl.Children(0)
End If
If Not IsObject(sess) Then
   Set sess = Connection.Children(0)
End If
If IsObject(WScript) Then
   WScript.ConnectObject sess, "on"
   WScript.ConnectObject Appl, "on"
End If
 
' составление таблиц и открытие ее.
 
sess.findById("wnd[0]").Maximize
sess.findById("wnd[0]/usr/cntlIMAGE_CONTAINER/shellcont/shell/shellcont[0]/shell").doubleClickNode "F00209"
sess.findById("wnd[0]/tbar[1]/btn[17]").press
sess.findById("wnd[1]/usr/txtENAME-LOW").Text = "safonova-o"
sess.findById("wnd[1]/usr/txtENAME-LOW").SetFocus
sess.findById("wnd[1]/usr/txtENAME-LOW").caretPosition = 10
sess.findById("wnd[1]/tbar[0]/btn[8]").press
sess.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").setCurrentCell 1, "TEXT"
sess.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").selectedRows = "1"
sess.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").doubleClickCurrentCell
sess.findById("wnd[0]/usr/tabsTABSTRIP_ORDER_CRITERIA/tabpS0S_TAB1/ssub%_SUBSCREEN_ORDER_CRITERIA:/BSHS/DM_SHP_MTRSTA:1010/ctxtP_VARI").Text = "/LYSIKOV"
sess.findById("wnd[0]/usr/tabsTABSTRIP_ORDER_CRITERIA/tabpS0S_TAB1/ssub%_SUBSCREEN_ORDER_CRITERIA:/BSHS/DM_SHP_MTRSTA:1010/ctxtP_VARI").SetFocus
sess.findById("wnd[0]/usr/tabsTABSTRIP_ORDER_CRITERIA/tabpS0S_TAB1/ssub%_SUBSCREEN_ORDER_CRITERIA:/BSHS/DM_SHP_MTRSTA:1010/ctxtP_VARI").caretPosition = 8
sess.findById("wnd[0]/tbar[1]/btn[8]").press
sess.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").setCurrentCell 2, "DPREG"
sess.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").selectedRows = "2"
sess.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").contextMenu
sess.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").selectContextMenuItem "&XXL"
sess.findById("wnd[1]/tbar[0]/btn[0]").press
sess.findById("wnd[1]/usr/ctxtDY_FILENAME").Text = "SHIPMENT.XLSX"
sess.findById("wnd[1]/usr/ctxtDY_FILENAME").caretPosition = 8
sess.findById("wnd[1]/tbar[0]/btn[11]").press
 
Call TT
End Sub
' сохранение открывшегося файла .XLSX
Sub TT()
Dim xlWb
Set xlWb = GetObject(, "Excel.Application")
xlWb.Parent.Windows(1).Visible = True
xlWb.Application.displayalerts = False
xlWb.Application.activeworkbook.SaveAs FileName:="\\bykna001\FREDIRECT$\Lysikov\Desktop\ëèñò ïîäáîðà\SHIPMENT2.XLSX", FileFormat:=51
xlWb.Quit
 
End Sub

@KoGG · 28.07.2016, 14:32

Удалить:

Visual Basic

1	xlWb.Parent.Windows(1).Visible = True

Переписать

Visual Basic

Sub TT()
Dim i&, xlWb
For i=1 to 30000: DoEvents : Next  ' Ожидание открытия файла
Set xlWb = GetObject(, "Excel.Application")
xlWb.Application.Visible = True
xlWb.Application.displayalerts = False
xlWb.Application.activeworkbook.SaveAs FileName:="\\bykna001\FREDIRECT$\Lysikov\Desktop\AAA\SHIPMENT2.XLSX", FileFormat:=51
xlWb.Quit
End Sub

@BSH · 28.07.2016, 16:30 **[ТС]**

Огромное спасибо. все заработало.

Добавлено через 1 час 36 минут
появился еще один вопрос.
мне нужно второй раз выгрузить похожий файл. но макрос сразу выдает ошибку:
compile error
duplicate declaration in current scope

я второй раз вставил ваш код. и у меня получилось желтым выделено Sub test(), и ошибка показывает на Dim i&, xlWb которая в самом низу.

Visual Basic

Sub test()
 
'Начало работы в сап
 
If Not IsObject(Appl) Then
   Set SapGuiAuto = GetObject("SAPGUI")
   Set Appl = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(Connection) Then
   Set Connection = Appl.Children(0)
End If
If Not IsObject(sess) Then
   Set sess = Connection.Children(0)
End If
If IsObject(WScript) Then
   WScript.ConnectObject sess, "on"
   WScript.ConnectObject Appl, "on"
End If
 
' составление таблицы и открытие ее.
 
sess.findById("wnd[0]").Maximize
sess.findById("wnd[0]/tbar[0]/okcd").Text = "/n/bshs/dm_shpmts"
sess.findById("wnd[0]").sendVKey 0
sess.findById("wnd[0]/tbar[1]/btn[17]").press
sess.findById("wnd[1]/usr/txtENAME-LOW").Text = "safonova-o"
sess.findById("wnd[1]/usr/txtENAME-LOW").SetFocus
sess.findById("wnd[1]/usr/txtENAME-LOW").caretPosition = 10
sess.findById("wnd[1]/tbar[0]/btn[8]").press
sess.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").setCurrentCell 1, "TEXT"
sess.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").selectedRows = "1"
sess.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").doubleClickCurrentCell
sess.findById("wnd[0]/usr/tabsTABSTRIP_ORDER_CRITERIA/tabpS0S_TAB1/ssub%_SUBSCREEN_ORDER_CRITERIA:/BSHS/DM_SHP_MTRSTA:1010/ctxtS_DPREG-LOW").Text = Format(Date - 4, "ddmmyy")
sess.findById("wnd[0]/usr/tabsTABSTRIP_ORDER_CRITERIA/tabpS0S_TAB1/ssub%_SUBSCREEN_ORDER_CRITERIA:/BSHS/DM_SHP_MTRSTA:1010/ctxtS_DPREG-HIGH").Text = Format(Date + 4, "ddmmyy")
sess.findById("wnd[0]/usr/tabsTABSTRIP_ORDER_CRITERIA/tabpS0S_TAB1/ssub%_SUBSCREEN_ORDER_CRITERIA:/BSHS/DM_SHP_MTRSTA:1010/ctxtP_VARI").Text = "/LYSIKOV"
sess.findById("wnd[0]/usr/tabsTABSTRIP_ORDER_CRITERIA/tabpS0S_TAB1/ssub%_SUBSCREEN_ORDER_CRITERIA:/BSHS/DM_SHP_MTRSTA:1010/ctxtS_DPREG-HIGH").SetFocus
sess.findById("wnd[0]/usr/tabsTABSTRIP_ORDER_CRITERIA/tabpS0S_TAB1/ssub%_SUBSCREEN_ORDER_CRITERIA:/BSHS/DM_SHP_MTRSTA:1010/ctxtS_DPREG-HIGH").caretPosition = 8
sess.findById("wnd[0]").sendVKey 0
sess.findById("wnd[0]/tbar[1]/btn[8]").press
sess.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").selectedRows = "0"
sess.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").contextMenu
sess.findById("wnd[0]/usr/cntlGRID1/shellcont/shell/shellcont[1]/shell").selectContextMenuItem "&XXL"
sess.findById("wnd[1]/tbar[0]/btn[0]").press
sess.findById("wnd[1]/usr/ctxtDY_PATH").Text = "\\bykna001\FREDIRECT$\Lysikov\Desktop\Лист подбора"
sess.findById("wnd[1]/usr/ctxtDY_FILENAME").Text = "Shipment sap.XLSX"
sess.findById("wnd[1]/usr/ctxtDY_FILENAME").caretPosition = 12
sess.findById("wnd[1]/tbar[0]/btn[11]").press
sess.findById("wnd[0]/tbar[0]/btn[3]").press
sess.findById("wnd[0]/tbar[0]/btn[3]").press
 
 
 
' открытую таблицу нужно перезаписать в формате .XLSX
 
Dim i&, xlWb
For i = 1 To 10000: DoEvents: Next ' Ожидание открытия файла
Set xlWb = GetObject(, "Excel.Application")
xlWb.Application.Visible = True
xlWb.Application.displayalerts = False
xlWb.Application.activeworkbook.SaveAs FileName:="\\bykna001\FREDIRECT$\Lysikov\Desktop\лист подбора\SHIPMENT access.XLSX", FileFormat:=51
xlWb.Quit
 
' закрытие dm_shpmts
 
sess.findById("wnd[0]").Maximize
sess.findById("wnd[0]/tbar[0]/btn[3]").press
sess.findById("wnd[0]/tbar[0]/btn[3]").press
 
' открытие bshl/wmm
 
sess.findById("wnd[0]").Maximize
sess.findById("wnd[0]/tbar[0]/okcd").Text = "/n/bshl/wmm"
sess.findById("wnd[0]").sendVKey 0
sess.findById("wnd[0]/usr/tabsTABSTRIP/tabpTS003").select
sess.findById("wnd[0]/usr/ctxt/BSHL/WM_C_DIALOG_D0100-BEZON").Text = "ru2"
sess.findById("wnd[0]").sendVKey 0
sess.findById("wnd[0]/usr/tabsTABSTRIP/tabpTS003/ssubTABAREA:/BSHL/WM_IWN_MONITOR:0900/subPARAMS:/BSHL/WM_IWN_MONITOR:0911/chkP0911004").Selected = False
sess.findById("wnd[0]/usr/tabsTABSTRIP/tabpTS003/ssubTABAREA:/BSHL/WM_IWN_MONITOR:0900/subPARAMS:/BSHL/WM_IWN_MONITOR:0911/chkP0911001").Selected = False
sess.findById("wnd[0]/usr/tabsTABSTRIP/tabpTS003/ssubTABAREA:/BSHL/WM_IWN_MONITOR:0900/subPARAMS:/BSHL/WM_IWN_MONITOR:0911/chkP0911001").SetFocus
sess.findById("wnd[0]/tbar[1]/btn[8]").press
sess.findById("wnd[0]/usr/cntlD0200_CUSCON/shellcont/shell").pressToolbarContextButton "&MB_VARIANT"
sess.findById("wnd[0]/usr/cntlD0200_CUSCON/shellcont/shell").pressToolbarButton "&MB_VARIANT"
sess.findById("wnd[1]/usr/cntlGRID/shellcont/shell").clickCurrentCell
sess.findById("wnd[0]/usr/cntlD0200_CUSCON/shellcont/shell").contextMenu
sess.findById("wnd[0]/usr/cntlD0200_CUSCON/shellcont/shell").selectContextMenuItem "&XXL"
sess.findById("wnd[1]/tbar[0]/btn[0]").press
sess.findById("wnd[1]/usr/ctxtDY_PATH").Text = "\\bykna001\FREDIRECT$\Lysikov\Desktop\Лист подбора"
sess.findById("wnd[1]/usr/ctxtDY_FILENAME").Text = "IWN Monitor.XLSX"
sess.findById("wnd[1]/tbar[0]/btn[11]").press
 
' открытую таблицу нужно перезаписать в формате .XLSX
 
Dim i&, xlWb
For i = 1 To 10000: DoEvents: Next ' Ожидание открытия файла
Set xlWb = GetObject(, "Excel.Application")
xlWb.Application.Visible = True
xlWb.Application.displayalerts = False
xlWb.Application.activeworkbook.SaveAs FileName:="\\bykna001\FREDIRECT$\Lysikov\Desktop\лист подбора\IWN Monitor access.XLSX", FileFormat:=51
xlWb.Quit
 
' закрытие bshl/wmm
 
session.findById("wnd[0]").Maximize
session.findById("wnd[0]/tbar[0]/btn[3]").press
session.findById("wnd[0]/tbar[0]/btn[3]").press
 
 
End Sub

@KoGG · 28.07.2016, 17:38

Надо убрать вторую строку

Visual Basic

1	Dim i&, xlWb

Хороший тон - все необходимые Dim (без задвоения) в начале процедуры.

@BSH · 10.08.2016, 18:18 **[ТС]**

Доброго времени суток.
Ни стал открывать новую тему. Нужна помощь.
В сохранении файла нужно добавить, что бы он сохранял и закрывал именно тот который открывается. Просто часто открыто сразу несколько файлов и когда запускается макрос:

Visual Basic

Dim i&, xlWb
For i = 1 To 15000: DoEvents: Next 
Set xlWb = GetObject(, "Excel.Application")
xlWb.Application.Visible = True
xlWb.Application.DisplayAlerts = False
xlWb.Application.activeworkbook.SaveAs FileName:="F:\SC\Bykovo Warehouse\Этикетка\lx03 access.XLSX", FileFormat:=51
xlWb.Quit

то закрываются все файлы. Это очень неудобно.

Можно что то сделать.

@KoGG · 11.08.2016, 09:29

Попробуйте везде вместо

Visual Basic

xlWb.Quit

написать

Visual Basic

1	xlWb.Application.displayalerts = True

@BSH · 11.08.2016, 09:43 **[ТС]**

Тоже вариант, спасибо. Теперь файлы остаются открытыми, вместе с остальными, а хотелось бы, что бы они закрывались.
и их не видели сотрудники. То есть мысль в чем.
Из программы извлекается файл exsel и открывается, мне нужно, чтобы файл сохранился в определенной папке и под определенным названием и потом закрылся. Это есть. но он закрывает и остальные exsel файлы. А нужно что бы закрывался только тот файл который открылся.

@KoGG · 11.08.2016, 13:08

Тогда так:

Visual Basic

1 2	xlWb.Application.displayalerts = True xlWb.Application.activeworkbook.Close 0

@BSH · 11.08.2016, 13:17 **[ТС]**

спасибо

Сохранение Excel-файла через макрос VBA в Access

Решение

Решение

@BSH 17 / 1 / 2 Регистрация: 20.04.2016 Сообщений: 120
	11.08.2016, 09:43 [ТС]	7
	Тоже вариант, спасибо. Теперь файлы остаются открытыми, вместе с остальными, а хотелось бы, что бы они закрывались. и их не видели сотрудники. То есть мысль в чем. Из программы извлекается файл exsel и открывается, мне нужно, чтобы файл сохранился в определенной папке и под определенным названием и потом закрылся. Это есть. но он закрывает и остальные exsel файлы. А нужно что бы закрывался только тот файл который открылся. 0

@BSH 17 / 1 / 2 Регистрация: 20.04.2016 Сообщений: 120
	11.08.2016, 13:17 [ТС]	9
	спасибо 0