Check for installed excel

wbeard52
11-19-2005, 03:39 PM
Is the only way to check to see if excel is installed in with the CreateObject function. I would like to place a routine in the Form Load event to check if the computer has excel and then set the enable on a command button. I am also using a template and adding data to this template through VB6. I have to keep the template saved with a certain cell having the focus or the data gets displayed wrongly when VB6 writes the file. Can someone point me to a place where I can set the focused cell through VB6

Thanks

George7a
11-19-2005, 03:51 PM
Hi: How to see which Microsoft Office Applications are installed

This tip shows how you could see which MS Office Applications are installed on your system. Create a new .exe project and add a module to it with the following code:

Option Explicit
Private Declare Function RegOpenKey Lib _
"advapi32" Alias "RegOpenKeyA" (ByVal hKey _
As Long, ByVal lpSubKey As String, _
phkResult As Long) As Long

Private Declare Function RegQueryValueEx _
Lib "advapi32" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As _
String, lpReserved As Long, lptype As _
Long, lpData As Any, lpcbData As Long) _
As Long

Private Declare Function RegCloseKey& Lib _
"advapi32" (ByVal hKey&)

Private Const REG_SZ = 1
Private Const REG_EXPAND_SZ = 2
Private Const ERROR_SUCCESS = 0
Public Const HKEY_CLASSES_ROOT = &H80000000

Public Function GetRegString(hKey As Long, _
strSubKey As String, strValueName As _
String) As String
Dim strSetting As String
Dim lngDataLen As Long
Dim lngRes As Long
If RegOpenKey(hKey, strSubKey, _
lngRes) = ERROR_SUCCESS Then
strSetting = Space(255)
lngDataLen = Len(strSetting)
If RegQueryValueEx(lngRes, _
strValueName, ByVal 0, _
REG_EXPAND_SZ, ByVal strSetting, _
lngDataLen) = ERROR_SUCCESS Then
If lngDataLen > 1 Then
GetRegString = Left(strSetting, lngDataLen - 1)
End If
End If

If RegCloseKey(lngRes) <> ERROR_SUCCESS Then
MsgBox "RegCloseKey Failed: " & _
strSubKey, vbCritical
End If
End If
End Function
On form1 put a CommandButton and four labels with the following code:

Option Explicit
Function FileExists(sFileName$) As Boolean
On Error Resume Next
FileExists = IIf(Dir(Trim(sFileName)) <> "", _
True, False)
End Function

Public Function IsAppPresent(strSubKey$, _
strValueName$) As Boolean
IsAppPresent = CBool(Len(GetRegString(HKEY_CLASSES_ROOT, _
strSubKey, strValueName)))
End Function

Private Sub Command1_Click()

Label1.Caption = "Access " & _
IsAppPresent("Access.Database\CurVer", "")

Label2.Caption = "Excel " & _
IsAppPresent("Excel.Sheet\CurVer", "")

Label3.Caption = "PowerPoint " & _
IsAppPresent("PowerPoint.Slide\CurVer", "")

Label4.Caption = "Word " & _
IsAppPresent("Word.Document\CurVer", "")

End Sub

I hope it helps,

- George

italkid
11-19-2005, 07:25 PM
I have to keep the template saved with a certain cell having the focus or the data gets displayed wrongly when VB6 writes the file. Can someone point me to a place where I can set the focused cell through VB6

Which makes me assume you do use code similar to "Activecell", which isn't necessary at all (only in rare cases). There are many ways to refer to a range (whether it's a cell, row, column, sheet etc..) without the need of activating it first. Could you show us that part of your code?

wbeard52
11-19-2005, 09:02 PM
Thanks for the "is office installed" routine, this was exactly what I was looking for. Here is my code to populate the excel sheet.


Public Sub PopulateSheet()
Dim strPath As String

If RightB(App.Path, 2) = "\" Then
strPath = App.Path & "Offering Template.xlt"
Else
strPath = App.Path & "\Offering Template.xlt"
End If

On Error Resume Next
Set myExcel = GetObject(strPath, Excel.Application)
On Error GoTo ExcelError
If myExcel Is Nothing Then _
Set myExcel = New Excel.Application
'mySheet.Application.Worksheets.Add

Dim oName As Excel.Range, oCash As Excel.Range
Dim oCheck As Excel.Range, oNumber As Excel.Range
Dim oTotal As Excel.Range, oDesig As Excel.Range
Dim oDate As Excel.Range, oTotalCash As Excel.Range
Dim oTotalCoin As Excel.Range, oTotalCheck As Excel.Range
Dim oTotalDeposit As Excel.Range, oUCash As Excel.Range

Set myBook = myExcel.Workbooks.Open(strPath)
Set mySheet = myBook.Worksheets("Sheet1")

Set oName = mySheet.Cells(6, 2)
Set oCash = mySheet.Cells(6, 3)
Set oNumber = mySheet.Cells(6, 4)
Set oCheck = mySheet.Cells(6, 5)
Set oTotal = mySheet.Cells(6, 6)
Set oDesig = mySheet.Cells(6, 7)
Set oDate = mySheet.Range("B3")
Set oUCash = mySheet.Cells(15, 3)
'-------------------------------------------------------------------------------
Dim cnn1 As ADODB.Connection, strCnn As String

If RightB(App.Path, 2) = "\" Then
strCnn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
App.Path & "Offering.mdb;Persist Security Info=False"
Else
strCnn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
App.Path & "\Offering.mdb;Persist Security Info=False"
End If
'Debug.Print strCnn
Set cnn1 = New ADODB.Connection
cnn1.Open strCnn

Dim adoDonation As ADODB.Recordset
Set adoDonation = New ADODB.Recordset
adoDonation.CursorType = adOpenForwardOnly
adoDonation.LockType = adLockOptimistic
adoDonation.CursorLocation = adUseClient
' Debug.Print lblOffering(6)
Dim sRs As String
sRs = "SELECT Donation.*, Offering.* FROM " _
& "Donation, Offering WHERE Donation.OfferingID = Offering.OfferingID and " _
& "Donation.Delete = NO and Offering.Delete = NO and Donation.OfferingID = " _
& Val(frmCFC.lblOffering(6)) & " ORDER BY PersonalName"

adoDonation.Open sRs, cnn1, , , adCmdText
'------------------------------------------------------------------------------
myExcel.ActiveCell.Activate
Set oTotalCash = mySheet.Range("C11")
Set oTotalCoin = mySheet.Range("C12")
Set oTotalCheck = mySheet.Range("E13")
Set oTotalDeposit = mySheet.Range("F14")

oDate = adoDonation!Date
oDate(1, 0) = Weekday(adoDonation!Date)
oTotalCash = adoDonation!CashAmount
oTotalCoin = adoDonation!CoinAmount
oTotalCheck = adoDonation!CheckAmount
oTotalDeposit = adoDonation!Total
oUCash = adoDonation!UndesignatedCash
Dim i As Integer
For i = 0 To adoDonation.RecordCount - 1
myExcel.ActiveCell.EntireRow.Insert (xlDown)
Next i
i = 0
Do Until adoDonation.EOF
If oName(3 + i, 1) <> adoDonation!PersonalName Then oName(4 + i, 1).Value = adoDonation!PersonalName
If adoDonation!PaymentMethod = "Cash" Then oCash(4 + i, 1).Value = adoDonation!TotalAmount
If adoDonation!PaymentMethod = "Check" Then oNumber(4 + i, 1).Value = adoDonation![Donation.CheckNumber]
If adoDonation!PaymentMethod = "Check" Then oCheck(4 + i, 1).Value = adoDonation!TotalAmount
If adoDonation!PaymentMethod = "Money Order" Then oNumber(4 + i, 1).Value = adoDonation![Donation.CheckNumber]
If adoDonation!PaymentMethod = "Money Order" Then oCheck(4 + i, 1).Value = adoDonation!TotalAmount
oTotal(4 + i, 1).Value = adoDonation!TotalAmount
If adoDonation!AccountName <> "General Fund" Then oDesig(4 + i, 1).Value = adoDonation!AccountName
i = i + 1
adoDonation.MoveNext
Loop
Dim sSaveFile As String, lDate As Long, dDate As Date
Dim lYear As String, lMonth As String, lDay As String
Dim oUsher1 As Excel.Range, oUsher2 As Excel.Range
dDate = CDate(oDate)
lYear = Year(dDate)
lMonth = Month(dDate)
lDay = Day(dDate)
lYear = IIf(Val(lYear) < 2000, "20" & lYear, lYear)
lMonth = IIf(Val(lMonth) < 10, "0" & lMonth, lMonth)
lDay = IIf(Val(lDay) < 10, "0" & lDay, lDay)
lDate = lYear & lMonth & lDay
Set oUsher1 = mySheet.Cells(17 + adoDonation.RecordCount, 3)
Set oUsher2 = mySheet.Cells(18 + adoDonation.RecordCount, 3)
oUsher1 = sMsg1
oUsher2 = sMsg2
Set oDate = mySheet.Cells(3, 1)
oDate = ""

With dlgCommonDialog(0)
.DialogTitle = "Save As"
.CancelError = False
'ToDo: set the flags and attributes of the common dialog control
.Filter = "All Files (*.xls)|*.xls"
.FileName = "Donation Report " & lDate
.ShowSave
sFolder = .FileName
sSaveFile = .FileName
End With
If Len(sSaveFile) <> 0 Then myBook.SaveAs sSaveFile
Dim BeginPage, EndPage, NumCopies
With dlgCommonDialog(1)
.DialogTitle = "Select Printer"
.CancelError = True
.ShowPrinter
BeginPage = .FromPage
EndPage = .ToPage
NumCopies = .Copies
For i = 1 To NumCopies
mySheet.PrintOut
Next i
End With
Set mySheet = Nothing
If Not myBook Is Nothing Then myBook.Close
Set myBook = Nothing
myExcel.Quit
Set myExcel = Nothing

adoDonation.Close
Set adoDonation = Nothing

cnn1.Close
Set cnn1 = Nothing

Exit Sub
Excel Error: Call Excel_Error
End Sub


Basically the routine calls up excel and adds up the number of records. Excel then insert that many rows and fills these with information from the recordset. Everything works fine, but if the focus is saved incorrectly bad things happen. Thanks for your help.

herilane
11-21-2005, 04:13 PM
myExcel.ActiveCell.EntireRow.Insert (xlDown)
This line tells Excel to insert rows above the active cell. If you want data to be inserted elsewhere, then specify a range instead of using ActiveCell.

EZ Archive Ads Plugin for vBulletin Copyright 2006 Computer Help Forum