Macro to export xls into csv format

shair_abbas — Wed, 20 Jan 2016 14:38:16 GMT

i got following code for gethub i want to save file in csv formate.
Please help me out.

sub advertiser

'// Array for export definitions

Dim aryExport(26,3)

aryExport(0,0) = "TX1888"

aryExport(0,1) = "advertiser"

aryExport(0,2) = "A1"

aryExport(0,3) = "image"

aryExport(1,0) = "TX1890"

aryExport(1,1) = "advertiser"

aryExport(1,2) = "F1"

aryExport(1,3) = "image"

aryExport(2,0) = "TX1889"

aryExport(2,1) = "advertiser"

aryExport(2,2) = "K1"

aryExport(2,3) = "image"

aryExport(3,0) = "TX1887"

aryExport(3,1) = "advertiser"

aryExport(3,2) = "P1"

aryExport(3,3) = "image"

aryExport(4,0) = "CH392"

aryExport(4,1) = "advertiser"

aryExport(4,2) = "A7"

aryExport(4,3) = "image"

aryExport(5,0) = "TX2007"

aryExport(5,1) = "advertiser"

aryExport(5,2) = "P7"

aryExport(5,3) = "image"

aryExport(6,0) = "TX1893"

aryExport(6,1) = "advertiser"

aryExport(6,2) = "P13"

aryExport(6,3) = "image"

aryExport(7,0) = "CH397"

aryExport(7,1) = "advertiser"

aryExport(7,2) = "A20"

aryExport(7,3) = "data"

aryExport(8,0) = "CH399"

aryExport(8,1) = "advertiser"

aryExport(8,2) = "I20"

aryExport(8,3) = "image"

aryExport(9,0) = "LB59"

aryExport(9,1) = "advertiser"

aryExport(9,2) = "M20"

aryExport(9,3) = "image"

aryExport(10,0) = "CH398"

aryExport(10,1) = "advertiser"

aryExport(10,2) = "P20"

aryExport(10,3) = "image"

aryExport(11,0) = "LB60"

aryExport(11,1) = "advertiser"

aryExport(11,2) = "T20"

aryExport(11,3) = "image"

aryExport(12,0) = "TX1908"

aryExport(12,1) = "advertiser"

aryExport(12,2) = "B36"

aryExport(12,3) = "image"

aryExport(13,0) = "CH396"

aryExport(13,1) = "advertiser"

aryExport(13,2) = "C38"

aryExport(13,3) = "image"

aryExport(14,0) = "TX1904"

aryExport(14,1) = "advertiser"

aryExport(14,2) = "A38"

aryExport(14,3) = "image"

aryExport(15,0) = "TX1903"

aryExport(15,1) = "advertiser"

aryExport(15,2) = "A40"

aryExport(15,3) = "image"

aryExport(16,0) = "TX1902"

aryExport(16,1) = "advertiser"

aryExport(16,2) = "A41"

aryExport(16,3) = "image"

aryExport(17,0) = "TX1906"

aryExport(17,1) = "advertiser"

aryExport(17,2) = "A43"

aryExport(17,3) = "image"

aryExport(18,0) = "CH421"

aryExport(18,1) = "advertiser"

aryExport(18,2) = "j39"

aryExport(18,3) = "image"

aryExport(19,0) = "TX1897"

aryExport(19,1) = "advertiser"

aryExport(19,2) = "j38"

aryExport(19,3) = "image"

aryExport(20,0) = "CH395"

aryExport(20,1) = "advertiser"

aryExport(20,2) = "l39"

aryExport(20,3) = "image"

aryExport(21,0) = "TX1905"

aryExport(21,1) = "advertiser"

aryExport(21,2) = "l38"

aryExport(21,3) = "image"

aryExport(22,0) = "TX1901"

aryExport(22,1) = "advertiser"

aryExport(22,2) = "t38"

aryExport(22,3) = "image"

aryExport(23,0) = "TX1898"

aryExport(23,1) = "advertiser"

aryExport(23,2) = "t40"

aryExport(23,3) = "image"

aryExport(24,0) = "TX1899"

aryExport(24,1) = "advertiser"

aryExport(24,2) = "t41"

aryExport(24,3) = "image"

aryExport(25,0) = "TX1900"

aryExport(25,1) = "advertiser"

aryExport(25,2) = "t43"

aryExport(25,3) = "image"

aryExport(26,0) = "CH400"

aryExport(26,1) = "advertiser"

aryExport(26,2) = "e47"

aryExport(26,3) = "image"

Dim objExcelWorkbook 'as Excel.Workbook

Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport)

Dim Worksheet

set Worksheet= createobject("Excel.Application")

Worksheet

Worksheet.Workbooks.Open "C:\Book1.xls"

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

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

'objExcelWorkbook.SaveCopyAsFileName = "D:01CTXGLDATR01_dfdM_FXA.csv"

WorkSheet.Workbooks(1).SaveAs "D:\test.csv",6

'createbackup=false

'chrdir "D:\"

'activeworkbook.SaveAs filename="D:\test.csv", FileFormat=xlcsv,_

'createbackup=false

'objExcelWorkbook.ActiveWorkbook.SaveAs Filename="D:\Book1.csv", FileFormat =xlCSVMSDOS, CreateBackup=False

end sub

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

'//__________________________________________________________________

topic Macro to export xls into csv format in QlikView

Macro to export xls into csv format

Re: Macro to export xls into csv format