Create New Excel file
Function uf_XLS_CreateNewFile(folderPath,fileName)
Dim rc, ExcelObj, objWorkbook
Set ExcelObj = CreateObject("Excel.Application")
Set objWorkbook = ExcelObj.Workbooks.Add
objWorkbook.Title = fileName
objWorkbook.Subject = fileName
objWorkbook.SaveAs folderPath & fileName
objWorkbook.Close
ExcelObj.Application.Quit
Set ExcelObj = Nothing
If Err.Number <> 0 Then rc = micFail Else rc = micPass
uf_XLS_CreateNewFile = rc
End Function
Get Specific Column Value:
Function uf_XLS_GetSpecificColumnValue(sExcelPath, sSheetName,sSearchCriteria , sField)
Dim objExcel
Dim objWorkbook
Dim sColumnName
Dim iKeywordRow
Dim iFeildColumn
Dim sValue
Dim arrSearchCriteria
arrSearchCriteria = Split(sSearchCriteria,"=")
sKeywordField = arrSearchCriteria(0)
sKeyword = arrSearchCriteria(1)
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
Set objWorkbook = objExcel.Workbooks.Open(Trim(sExcelPath))
objExcel.Sheets(Trim(sSheetName)).Select
iColumnNumber = objExcel.Cells.Find(Trim(sKeywordField)).Column
sColumnName = uf_XLS_ConvertColNoToColName(iColumnNumber)
iKeywordRow = objExcel.Range(sColumnName & ":" & sColumnName).Find(Trim(sKeyword)).Row
If sField = "" Then
iFeildColumn = objExcel.Cells.Find(Trim(sKeyword)).Column + 1
Else
iFeildColumn = objExcel.Cells.Find(Trim(sField)).Column
End If
sValue = Trim(objExcel.Cells(iKeywordRow, iFeildColumn))
objWorkbook.close
objExcel.Quit
Set objWorkbook = Nothing
Set objExcel=Nothing
uf_XLS_GetSpecificColumnValue = sValue
End Function
Read Data from ADODB connection:
Function uf_XLS_ExecuteSQLQuery(sExcelPath,sProvider, sSQL)
Dim oConn, objRecordSet, sQuery
Dim intFieldIndex
Set oConn= CreateObject("ADODB.Connection")
If UCase(sProvider) ="ACE" Then
oConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sExcelPath & ";Extended Properties=""Excel 12.0;IMAX=1;HDR=Yes;"";"
'oConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sExcelPath & ";Extended Properties=""Excel 12.0 Xml;IMAX=1;HDR=Yes"";"
ElseIf UCase(sProvider) = "JET" Then
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sExcelPath & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
End If
Set objRecordSet = oConn.Execute(sSQL)
Set uf_XLS_ExecuteSQLQuery = objRecordSet
End Function
Update excel column value:
Function uf_XLS_UpdateMultipleColumnsValue(sExcelPath, sSheetName,sSearchCriteria , sFieldValueList)
Dim objExcel
Dim objWorkbook
Dim sColumnName
Dim iKeywordRow
Dim iFeildColumn
Dim arrSearchCriteria
arrSearchCriteria = Split(sSearchCriteria,"=")
sKeywordField = arrSearchCriteria(0)
sKeyword = arrSearchCriteria(1)
arrFieldValueList = Split(sFieldValueList,"#")
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
Set objWorkbook = objExcel.Workbooks.Open(Trim(sExcelPath))
objExcel.Sheets(Trim(sSheetName)).Select
iColumnNumber = objExcel.Cells.Find(Trim(sKeywordField)).Column
sColumnName = uf_XLS_ConvertColNoToColName(iColumnNumber)
iKeywordRow = objExcel.Range(sColumnName & ":" & sColumnName).Find(Trim(sKeyword)).Row
For iLoop = 0 to Ubound(arrFieldValueList)
arrFieldValue = Split(arrFieldValueList(iLoop),"=")
iFeildColumn = objExcel.Cells.Find(Trim(arrFieldValue(0))).Column
objExcel.Cells(iKeywordRow, iFeildColumn) = Trim(arrFieldValue(1))
Next
objExcel.ActiveWorkbook.Save
If Err.Number <> 0 Then rc = micFail Else rc = micPass
objWorkbook.close
objExcel.Application.Quit
Set objWorkbook = Nothing
Set objExcel=Nothing
uf_XLS_UpdateMultipleColumnsValue = rc
End Function
Function uf_XLS_CreateNewFile(folderPath,fileName)
Dim rc, ExcelObj, objWorkbook
Set ExcelObj = CreateObject("Excel.Application")
Set objWorkbook = ExcelObj.Workbooks.Add
objWorkbook.Title = fileName
objWorkbook.Subject = fileName
objWorkbook.SaveAs folderPath & fileName
objWorkbook.Close
ExcelObj.Application.Quit
Set ExcelObj = Nothing
If Err.Number <> 0 Then rc = micFail Else rc = micPass
uf_XLS_CreateNewFile = rc
End Function
Get Specific Column Value:
Function uf_XLS_GetSpecificColumnValue(sExcelPath, sSheetName,sSearchCriteria , sField)
Dim objExcel
Dim objWorkbook
Dim sColumnName
Dim iKeywordRow
Dim iFeildColumn
Dim sValue
Dim arrSearchCriteria
arrSearchCriteria = Split(sSearchCriteria,"=")
sKeywordField = arrSearchCriteria(0)
sKeyword = arrSearchCriteria(1)
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
Set objWorkbook = objExcel.Workbooks.Open(Trim(sExcelPath))
objExcel.Sheets(Trim(sSheetName)).Select
iColumnNumber = objExcel.Cells.Find(Trim(sKeywordField)).Column
sColumnName = uf_XLS_ConvertColNoToColName(iColumnNumber)
iKeywordRow = objExcel.Range(sColumnName & ":" & sColumnName).Find(Trim(sKeyword)).Row
If sField = "" Then
iFeildColumn = objExcel.Cells.Find(Trim(sKeyword)).Column + 1
Else
iFeildColumn = objExcel.Cells.Find(Trim(sField)).Column
End If
sValue = Trim(objExcel.Cells(iKeywordRow, iFeildColumn))
objWorkbook.close
objExcel.Quit
Set objWorkbook = Nothing
Set objExcel=Nothing
uf_XLS_GetSpecificColumnValue = sValue
End Function
Read Data from ADODB connection:
Function uf_XLS_ExecuteSQLQuery(sExcelPath,sProvider, sSQL)
Dim oConn, objRecordSet, sQuery
Dim intFieldIndex
Set oConn= CreateObject("ADODB.Connection")
If UCase(sProvider) ="ACE" Then
oConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sExcelPath & ";Extended Properties=""Excel 12.0;IMAX=1;HDR=Yes;"";"
'oConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sExcelPath & ";Extended Properties=""Excel 12.0 Xml;IMAX=1;HDR=Yes"";"
ElseIf UCase(sProvider) = "JET" Then
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sExcelPath & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
End If
Set objRecordSet = oConn.Execute(sSQL)
Set uf_XLS_ExecuteSQLQuery = objRecordSet
End Function
Update excel column value:
Function uf_XLS_UpdateMultipleColumnsValue(sExcelPath, sSheetName,sSearchCriteria , sFieldValueList)
Dim objExcel
Dim objWorkbook
Dim sColumnName
Dim iKeywordRow
Dim iFeildColumn
Dim arrSearchCriteria
arrSearchCriteria = Split(sSearchCriteria,"=")
sKeywordField = arrSearchCriteria(0)
sKeyword = arrSearchCriteria(1)
arrFieldValueList = Split(sFieldValueList,"#")
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
Set objWorkbook = objExcel.Workbooks.Open(Trim(sExcelPath))
objExcel.Sheets(Trim(sSheetName)).Select
iColumnNumber = objExcel.Cells.Find(Trim(sKeywordField)).Column
sColumnName = uf_XLS_ConvertColNoToColName(iColumnNumber)
iKeywordRow = objExcel.Range(sColumnName & ":" & sColumnName).Find(Trim(sKeyword)).Row
For iLoop = 0 to Ubound(arrFieldValueList)
arrFieldValue = Split(arrFieldValueList(iLoop),"=")
iFeildColumn = objExcel.Cells.Find(Trim(arrFieldValue(0))).Column
objExcel.Cells(iKeywordRow, iFeildColumn) = Trim(arrFieldValue(1))
Next
objExcel.ActiveWorkbook.Save
If Err.Number <> 0 Then rc = micFail Else rc = micPass
objWorkbook.close
objExcel.Application.Quit
Set objWorkbook = Nothing
Set objExcel=Nothing
uf_XLS_UpdateMultipleColumnsValue = rc
End Function
I really enjoy the blog.Much thanks again. Really Great. salesforce Online Training
ReplyDelete