Saving Excel File

Tue, 11 Feb 2014 13:16:53 GMT

Hi, I'm here again!

I have the followed VB Script that I copied from a post here. This script works very well but I'd like to save the excel file created and I don't how to do it.

I'd like to save and replace the document created every time I use the MACRO.

How do I complete the script?

VB Script
sub exportToExcel_Variant3 Dim aryExport(10,3) aryExport(0,0) = "CH150" aryExport(0,1) = "Base" aryExport(0,2) = "A1" aryExport(0,3) = "data" aryExport(1,0) = "CH156" aryExport(1,1) = "Base" aryExport(1,2) = "E1" aryExport(1,3) = "data" aryExport(2,0) = "CH160" aryExport(2,1) = "Base" aryExport(2,2) = "G11" aryExport(2,3) = "data" aryExport(3,0) = "CH154" aryExport(3,1) = "Base" aryExport(3,2) = "AA1" aryExport(3,3) = "data" aryExport(4,0) = "CH152" aryExport(4,1) = "Base" aryExport(4,2) = "K1" aryExport(4,3) = "data" aryExport(5,0) = "CH158" aryExport(5,1) = "Base" aryExport(5,2) = "K11" aryExport(5,3) = "data" aryExport(6,0) = "CH155" aryExport(6,1) = "Base" aryExport(6,2) = "O1" aryExport(6,3) = "data" aryExport(7,0) = "CH151" aryExport(7,1) = "Base" aryExport(7,2) = "A11" aryExport(7,3) = "data" aryExport(8,0) = "CH159" aryExport(8,1) = "Base" aryExport(8,2) = "S1" aryExport(8,3) = "data" aryExport(9,0) = "CH157" aryExport(9,1) = "Base" aryExport(9,2) = "O11" aryExport(9,3) = "data" aryExport(10,0) = "CH153" aryExport(10,1) = "Base" aryExport(10,2) = "U11" aryExport(10,3) = "data" 'aryExport(11,0) = "TX53" 'aryExport(11,1) = "Base" 'aryExport(11,2) = "A22" 'aryExport(11,3) = "data" ' 'aryExport(12,0) = "TX52" 'aryExport(12,1) = "Base" 'aryExport(12,2) = "A24" 'aryExport(12,3) = "data" Dim objExcelWorkbook 'as Excel.Workbook Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport) '// Now either just leave Excel open or do some other stuff here '// like saving the excel, some formatting stuff, ... end sub '// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! '// YOU DO NOT NEED TO CHANGE THE CODE BELOW !!!!!!!!!!!!!!!!!!!!!!! '// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! '// ************************************************************** '// copyObjectsToExcel '// ~~ '// Parameters: '// qvDoc - Reference to the QlikView document (normally just use '// "ActiveDocument", but you can also use copyObjectsToExcel '// outside of QlikView ... '// aryExportDefinition - array of settings '// ~~ '// Version 1.02 '// ~~ '// The aryExportDefinition is used to pass the following properties to '// copyObjectsToExcelSheet: '// '// Index Description '// ------------------------ '// 0 - Id of the QlikView object to copy from '// 1 - Name of the sheet (in Excel) where the object should be copied to '// '// (If a sheet with the same name already exists no new '// sheet will be created, instead the existing sheet will '// be used for pasting the object) '// '// Note: the sheetName can be max 31 characters long '// '// 2 - Range in Excel where the object should be pasted to '// 3 - PasteMode ["data", "image"] '// Defines if the objects underlaying data should be '// pasted ("data") or the the image representing the object '// should be used '// ************************************************************ Private Function copyObjectsToExcelSheet(qvDoc, aryExportDefinition) 'as Excel.Workbook Dim i 'as Integer Dim objExcelApp 'as Excel.Application Dim objExcelDoc 'as Excel.Workbook Set objExcelApp = CreateObject("Excel.Application") objExcelApp.Visible = true 'false if you want to hide Excel objExcelApp.DisplayAlerts = false Set objExcelDoc = objExcelApp.Workbooks.Add Dim strSourceObject Dim qvObjectId 'as String Dim sheetName Dim sheetRange Dim pasteMode Dim objSource Dim objCurrentSheet Dim objExcelSheet for i = 0 to UBOUND(aryExportDefinition) '// Get the properties of the exportDefinition array qvObjectId = aryExportDefinition(i,0) sheetName = aryExportDefinition(i,1) sheetRange = aryExportDefinition(i,2) pasteMode = aryExportDefinition(i,3) Set objExcelSheet = Excel_GetSheetByName(objExcelDoc, sheetName) if (objExcelSheet is nothing) then Set objExcelSheet = Excel_AddSheet(objExcelApp, sheetName) if (objExcelSheet is nothing) then msgbox("No sheet could be created, this should not occur!!!") end if end if objExcelSheet.Select set objSource = qvDoc.GetSheetObject(qvObjectId) Call objSource.GetSheet().Activate() objSource.Maximize qvDoc.GetApplication.WaitForIdle if (not objSource is nothing) then if (pasteMode = "image") then Call objSource.CopyBitmapToClipboard() else Call objSource.CopyTableToClipboard(true) '// default & fallback end if Set objCurrentSheet = objExcelDoc.Sheets(sheetName) objExcelDoc.Sheets(sheetName).Range(sheetRange).Select objExcelDoc.Sheets(sheetName).Paste if (pasteMode <> "image") then With objExcelApp.Selection .WrapText = False .ShrinkToFit = False End With end if objCurrentSheet.Range("A1").Select end if next Call Excel_DeleteBlankSheets(objExcelDoc) '// Finally select the first sheet objExcelDoc.Sheets(1).Select '// Return value Set copyObjectsToExcelSheet = objExcelDoc end function '// ________________________________________________________________ '// ************************************************************ '// Internal function for getting the Excel sheet by sheetName '// ************************************************************ Private Function Excel_GetSheetByName(ByRef objExcelDoc, sheetName) 'as Excel.Sheet For Each ws In objExcelDoc.Worksheets If (trim(ws.Name) = Excel_GetSafeSheetName(sheetName)) then Set Excel_GetSheetByName = ws exit function End If Next '// default return value Set Excel_GetSheetByName = nothing End Function '// ________________________________________________________________ Private Function Excel_GetSafeSheetName(sheetName) '// can be max 31 characters long retVal = trim(left(sheetName, 31)) Excel_GetSafeSheetName = retVal End Function '// ************************************************************ '// Internal function for adding a new sheet '// ************************************************************ Private Function Excel_AddSheet(objExcelApplication, sheetName) ' as Excel.Sheet '// add a sheet to the last position objExcelApplication.Sheets.Add , objExcelApplication.Sheets(objExcelApplication.Sheets.Count) Dim objNewSheet Set objNewSheet = objExcelApplication.Sheets(objExcelApplication.Sheets.Count) objNewSheet.Name = left(sheetName,31) '// return the newly created sheet Set Excel_AddSheet = objNewSheet End function '// ________________________________________________________________ '// ************************************************************ '// Delete all empty sheets '// ************************************************************ Private Sub Excel_DeleteBlankSheets(ByRef objExcelDoc) For Each ws In objExcelDoc.Worksheets If (not HasOtherObjects(ws)) then If objExcelDoc.Application.WorksheetFunction.CountA(ws.Cells) = 0 Then On Error Resume Next Call ws.Delete() End If End If Next End Sub '// ________________________________________________________________ '// ************************************************************ '// Helper function to determine if there are other objects placed '// on the sheet ... '// ************************************************************** Public Function HasOtherObjects(ByRef objSheet) 'As Boolean Dim c If (objSheet.ChartObjects.Count > 0) Then HasOtherObjects = true Exit function End If If (objSheet.Pictures.Count > 0) Then HasOtherObjects = true Exit function End If If (objSheet.Shapes.Count > 0) Then HasOtherObjects = true Exit function End If HasOtherObjects = false End Function '//__________________________________________________________________

VB Script

sub exportToExcel_Variant3

Dim aryExport(10,3)

aryExport(0,0) = "CH150"

aryExport(0,1) = "Base"

aryExport(0,2) = "A1"

aryExport(0,3) = "data"

aryExport(1,0) = "CH156"

aryExport(1,1) = "Base"

aryExport(1,2) = "E1"

aryExport(1,3) = "data"

aryExport(2,0) = "CH160"

aryExport(2,1) = "Base"

aryExport(2,2) = "G11"

aryExport(2,3) = "data"

aryExport(3,0) = "CH154"

aryExport(3,1) = "Base"

aryExport(3,2) = "AA1"

aryExport(3,3) = "data"

aryExport(4,0) = "CH152"

aryExport(4,1) = "Base"

aryExport(4,2) = "K1"

aryExport(4,3) = "data"

aryExport(5,0) = "CH158"

aryExport(5,1) = "Base"

aryExport(5,2) = "K11"

aryExport(5,3) = "data"

aryExport(6,0) = "CH155"

aryExport(6,1) = "Base"

aryExport(6,2) = "O1"

aryExport(6,3) = "data"

aryExport(7,0) = "CH151"

aryExport(7,1) = "Base"

aryExport(7,2) = "A11"

aryExport(7,3) = "data"

aryExport(8,0) = "CH159"

aryExport(8,1) = "Base"

aryExport(8,2) = "S1"

aryExport(8,3) = "data"

aryExport(9,0) = "CH157"

aryExport(9,1) = "Base"

aryExport(9,2) = "O11"

aryExport(9,3) = "data"

aryExport(10,0) = "CH153"

aryExport(10,1) = "Base"

aryExport(10,2) = "U11"

aryExport(10,3) = "data"

'aryExport(11,0) = "TX53"

'aryExport(11,1) = "Base"

'aryExport(11,2) = "A22"

'aryExport(11,3) = "data"

'aryExport(12,0) = "TX52"

'aryExport(12,1) = "Base"

'aryExport(12,2) = "A24"

'aryExport(12,3) = "data"

Dim objExcelWorkbook 'as Excel.Workbook

Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport)

'// Now either just leave Excel open or do some other stuff here

'// like saving the excel, some formatting stuff, ...

end sub

'// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

'// YOU DO NOT NEED TO CHANGE THE CODE BELOW !!!!!!!!!!!!!!!!!!!!!!!

'// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

'// ****************************************************************

'// copyObjectsToExcel

'// ~~

'// Parameters:

'// qvDoc - Reference to the QlikView document (normally just use

'// "ActiveDocument", but you can also use copyObjectsToExcel

'// outside of QlikView ...

'// aryExportDefinition - array of settings

'// ~~

'// Version 1.02

'// ~~

'// The aryExportDefinition is used to pass the following properties to

'// copyObjectsToExcelSheet:

'//

'// Index Description

'// ------------------------

'// 0 - Id of the QlikView object to copy from

'// 1 - Name of the sheet (in Excel) where the object should be copied to

'//

'// (If a sheet with the same name already exists no new

'// sheet will be created, instead the existing sheet will

'// be used for pasting the object)

'//

'// Note: the sheetName can be max 31 characters long

'//

'// 2 - Range in Excel where the object should be pasted to

'// 3 - PasteMode ["data", "image"]

'// Defines if the objects underlaying data should be

'// pasted ("data") or the the image representing the object

'// should be used

'// ****************************************************************

Private Function copyObjectsToExcelSheet(qvDoc, aryExportDefinition) 'as Excel.Workbook

Dim i 'as Integer

Dim objExcelApp 'as Excel.Application

Dim objExcelDoc 'as Excel.Workbook

Set objExcelApp = CreateObject("Excel.Application")

objExcelApp.Visible = true 'false if you want to hide Excel

objExcelApp.DisplayAlerts = false

Set objExcelDoc = objExcelApp.Workbooks.Add

Dim strSourceObject

Dim qvObjectId 'as String

Dim sheetName

Dim sheetRange

Dim pasteMode

Dim objSource

Dim objCurrentSheet

Dim objExcelSheet

for i = 0 to UBOUND(aryExportDefinition)

'// Get the properties of the exportDefinition array

qvObjectId = aryExportDefinition(i,0)

sheetName = aryExportDefinition(i,1)

sheetRange = aryExportDefinition(i,2)

pasteMode = aryExportDefinition(i,3)

Set objExcelSheet = Excel_GetSheetByName(objExcelDoc, sheetName)

if (objExcelSheet is nothing) then

Set objExcelSheet = Excel_AddSheet(objExcelApp, sheetName)

if (objExcelSheet is nothing) then

msgbox("No sheet could be created, this should not occur!!!")

end if

objExcelSheet.Select

set objSource = qvDoc.GetSheetObject(qvObjectId)

Call objSource.GetSheet().Activate()

objSource.Maximize

qvDoc.GetApplication.WaitForIdle

if (not objSource is nothing) then

if (pasteMode = "image") then

Call objSource.CopyBitmapToClipboard()

else

Call objSource.CopyTableToClipboard(true) '// default & fallback

end if

Set objCurrentSheet = objExcelDoc.Sheets(sheetName)

objExcelDoc.Sheets(sheetName).Range(sheetRange).Select

objExcelDoc.Sheets(sheetName).Paste

if (pasteMode <> "image") then

With objExcelApp.Selection

.WrapText = False

.ShrinkToFit = False

End With

end if

objCurrentSheet.Range("A1").Select

end if

Call Excel_DeleteBlankSheets(objExcelDoc)

'// Finally select the first sheet

objExcelDoc.Sheets(1).Select

'// Return value

Set copyObjectsToExcelSheet = objExcelDoc

end function

'// ________________________________________________________________

'// ****************************************************************

'// Internal function for getting the Excel sheet by sheetName

'// ****************************************************************

Private Function Excel_GetSheetByName(ByRef objExcelDoc, sheetName) 'as Excel.Sheet

For Each ws In objExcelDoc.Worksheets

If (trim(ws.Name) = Excel_GetSafeSheetName(sheetName)) then

Set Excel_GetSheetByName = ws

exit function

End If

'// default return value

Set Excel_GetSheetByName = nothing

End Function

'// ________________________________________________________________

Private Function Excel_GetSafeSheetName(sheetName)

'// can be max 31 characters long

retVal = trim(left(sheetName, 31))

Excel_GetSafeSheetName = retVal

End Function

'// ****************************************************************

'// Internal function for adding a new sheet

'// ****************************************************************

Private Function Excel_AddSheet(objExcelApplication, sheetName) ' as Excel.Sheet

'// add a sheet to the last position

objExcelApplication.Sheets.Add , objExcelApplication.Sheets(objExcelApplication.Sheets.Count)

Dim objNewSheet

Set objNewSheet = objExcelApplication.Sheets(objExcelApplication.Sheets.Count)

objNewSheet.Name = left(sheetName,31)

'// return the newly created sheet

Set Excel_AddSheet = objNewSheet

End function

'// ________________________________________________________________

'// ****************************************************************

'// Delete all empty sheets

'// ****************************************************************

Private Sub Excel_DeleteBlankSheets(ByRef objExcelDoc)

For Each ws In objExcelDoc.Worksheets

If (not HasOtherObjects(ws)) then

If objExcelDoc.Application.WorksheetFunction.CountA(ws.Cells) = 0 Then

On Error Resume Next

Call ws.Delete()

End If

End Sub

'// ________________________________________________________________

'// ****************************************************************

'// Helper function to determine if there are other objects placed

'// on the sheet ...

'// ****************************************************************

Public Function HasOtherObjects(ByRef objSheet) 'As Boolean

Dim c

If (objSheet.ChartObjects.Count > 0) Then

HasOtherObjects = true

Exit function

End If

If (objSheet.Pictures.Count > 0) Then

HasOtherObjects = true

Exit function

End If

If (objSheet.Shapes.Count > 0) Then

HasOtherObjects = true

Exit function

End If

HasOtherObjects = false

End Function

'//__________________________________________________________________

Re: Saving Excel File

trdandamudi — Sat, 24 Sep 2016 02:51:23 GMT

You need the following line of code:

objExcelWorkbook.SaveAs ("C:\Temp\Sample_File.xlsx")

Add the above line to your "exportToExcel_Variant3" routine. You need to place the above line of code after the following lines:

Dim objExcelWorkbook 'as Excel.Workbook

Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport)

Note: So whenever you run this macro, it will export to excel and saves the excel in C:\Temp as "Sample_File,xlsx". If you already have the file it will replace it,

Hope this helps...

topic Re: Saving Excel File in QlikView

Saving Excel File

Re: Saving Excel File

Re: Saving Excel File

Re: Saving Excel File

Re: Saving Excel File