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
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
'//__________________________________________________________________
