How to Copy Access query to Excel?

[daiweisc]

Hi,I want to copy Access query to Excel, But the code is run not well.
Can anyone give me a tips to solve this problem.

Code: Select all

#NoEnv
#SingleInstance,Force
dmb := ComObjCreate("Access.Application")  ;Create new instance of Microsoft dmbess.
FileName := "技术委员会台账"
Ac :="F:\华鹤煤化\生产管理部\工艺管理\技术委员会会议纪要\" FileName ".accdb"
dmb.OpenCurrentDatabase(Ac)
objExcel := ComObjCreate("Excel.Application") 
objExcel.DisplayAlerts := False
Global objExcel

AccessCopy(Query,FileName,Sheet){
    dmb.DoCmd.OpenQuery(Query)
    dmb.DoCmd.SelectObject(1,Query,0)
    dmb.DoCmd.RunCommand(109)
    dmb.DoCmd.RunCommand(190)
    objWorkbook :=objExcel.Workbooks.Open(FileName) ;需要粘贴的目标工作薄
    objWorkbook.Sheets(Sheet).Range("A1").Paste
    ;objWorkbook.Sheets(Sheet).PasteSpecial(-4163)
    objWorkbook.Close(1)
	Clipboard := ""
}
Query := "cxGYGB"
Sheet := "公用工程部"
FileName := "F:\华鹤煤化\生产管理部\工艺管理\技术委员会会议纪要\技术委员会台账（部门分类）.xlsx"
AccessCopy(Query,FileName,Sheet)

objExcel.Quit()
objExcel := ""
dmb.CloseCurrentDatabase
dmb.quit
ExitApp

[flyingDman]

This works for me:

Code: Select all

dmb := ComObjCreate("Access.Application")  						;Create new instance of Microsoft dmbess.
dmb.OpenCurrentDatabase("C:\Users\xxx\Documents\Data Bases\numbers.accdb")
dmb.DoCmd.OpenQuery("Query1")
dmb.DoCmd.RunCommand(109)										; select all records
dmb.DoCmd.RunCommand(190)										; copy

xl:= ComObjCreate("Excel.Application") 
wrkbk :=Xl.Workbooks.Open("C:\Users\xxx\Scripts\accessimport.xlsx")
wrkbk.worksheets("sheet1").range("a1").pastespecial(-4163)				; or Xl.Range("A1").PasteSpecial(-4163)

wrkbk.Close(1)
Clipboard := ""
xl.Quit()
xl := ""
dmb.CloseCurrentDatabase
dmb.Quit()
dmb := ""
msgbox,,,done,3
ExitApp

[daiweisc]

My code change, but the clipboard is empty, the excel file is no change, is no save.

Code: Select all

#NoEnv
#SingleInstance,Force
dmb := ComObjCreate("Access.Application")  ;Create new instance of Microsoft dmbess.
FileName := "技术委员会台账"
Ac :="F:\华鹤煤化\生产管理部\工艺管理\技术委员会会议纪要\" FileName ".accdb"
dmb.OpenCurrentDatabase(Ac)

;-------------------------------------------------------------------------------------------
AccessCopy(Query,FileName,Sheet){
    dmb.DoCmd.OpenQuery(Query)    
    dmb.DoCmd.RunCommand(109)       ; select all records
    dmb.DoCmd.RunCommand(190)       ; copy
    wl := ComObjCreate("Excel.Application") 
    wl.DisplayAlerts := False
    wrkbk :=xl.Workbooks.Open(FileName) ;需要粘贴的目标工作薄
    ;MsgBox %Clipboard%
    wrkbk.WorkSheets(Sheet).Range("A1").PasteSpecial(-4163)     ; or Xl.Range("A1").PasteSpecial(-4163)
    ;wrkbk.Save()
    wrkbk.Close(1)
    Clipboard := ""
    xl.Quit()
    xl := ""
}
Query := "cxGYGB"
Sheet := "公用工程部"
FileName := "F:\华鹤煤化\生产管理部\工艺管理\技术委员会会议纪要\技术委员会台账2.xlsx"
AccessCopy(Query,FileName,Sheet)
;-------------------------------------------------------------------------------------------------
dmb.CloseCurrentDatabase
dmb.quit()
dmb := ""
msgbox,,,done,3
ExitApp

[flyingDman]

wl ? should be xl

[daiweisc]

thangks give the tips. But Clipboard is still empty. I guess the cammand of OpenQuery and RunCommand is not work.

Code: Select all

#NoEnv
#SingleInstance,Force
dmb := ComObjCreate("Access.Application")  ;Create new instance of Microsoft dmbess.
FileName := "技术委员会台账"
Ac :="F:\华鹤煤化\生产管理部\工艺管理\技术委员会会议纪要\" FileName ".accdb"
dmb.OpenCurrentDatabase(Ac)

;-------------------------------------------------------------------------------------------
AccessCopy(Query,FileName,Sheet){
    dmb.DoCmd.OpenQuery(Query) 
    dmb.DoCmd.SelectObject(1,Query,0)
    dmb.DoCmd.RunCommand(109)       ; select all records
    dmb.DoCmd.RunCommand(190)       ; copy
    xl := ComObjCreate("Excel.Application") 
    xl.DisplayAlerts := False
    wrkbk :=xl.Workbooks.Open(FileName) ;需要粘贴的目标工作薄
    ;MsgBox %Clipboard%
    wrkbk.WorkSheets(Sheet).PasteSpecial(-4163)     ; or Xl.Range("A1").PasteSpecial(-4163)
    ;wrkbk.Save()
    wrkbk.Close(1)
    Clipboard := ""
    xl.Quit()
    xl := ""
}
Query := "cxGYGB"
Sheet := "公用工程部"
FileName := "F:\华鹤煤化\生产管理部\工艺管理\技术委员会会议纪要\技术委员会台账3.xlsx"
AccessCopy(Query,FileName,Sheet)
;-------------------------------------------------------------------------------------------------
dmb.CloseCurrentDatabase
dmb.quit()
dmb := ""
msgbox,,,done,3
ExitApp

[daiweisc]

Thanks flyingDman. I find the problem, add global dmb. the correct code is

Code: Select all

#NoEnv
#SingleInstance,Force
Clipboard := ""
dmb := ComObjCreate("Access.Application")  ;Create new instance of Microsoft dmbess.
Global dmb
FileName := "技术委员会台账"
Ac :="F:\华鹤煤化\生产管理部\工艺管理\技术委员会会议纪要\" FileName ".accdb"
dmb.OpenCurrentDatabase(Ac)

;-------------------------------------------------------------------------------------------
AccessCopy(Query,FileName,Sheet){
    dmb.DoCmd.OpenQuery(Query) 
    dmb.DoCmd.RunCommand(109)       ; select all records
    dmb.DoCmd.RunCommand(190)       ; copy
    xl := ComObjCreate("Excel.Application") 
    ;xl.DisplayAlerts := False
    wrkbk :=xl.Workbooks.Open(FileName) ;需要粘贴的目标工作薄
    wrkbk.WorkSheets(Sheet)..UsedRange.Clear	
    ;MsgBox %Clipboard%
    wrkbk.WorkSheets(Sheet).Range("A1").PasteSpecial(-4163)     ; or Xl.Range("A1").PasteSpecial(-4163)
    wrkbk.Close(1)
    Clipboard := ""
    xl.Quit()
    xl := ""
}
Query := "cxGYGB"
Sheet := "公用工程部"
FileName := "F:\华鹤煤化\生产管理部\工艺管理\技术委员会会议纪要\技术委员会台账3.xlsx"
AccessCopy(Query,FileName,Sheet)
;-------------------------------------------------------------------------------------------------
dmb.CloseCurrentDatabase
dmb.quit()
dmb := ""
msgbox,,,done,3
ExitApp