Hi

What have I done that is wrong
the Excell sheet will not be visible
I will have it visible
when I press the command button

Dim objXl As New excel.Application
Dim objWb As excel.Workbook

    Dim xlTmp As excel.Application
    Set xlTmp = excel.Application
    xlTmp.Workbooks.open ("c:\kundreg\bokfaktura2.xls") '"bokfaktura2.xls"
    xlTmp.Workbooks.open ("app.path & \kundreg\bokfaktura2.xls") 'don't work

    'the excel sheet is not visible
    ' to edit the sheet I will see the sheet

On Error GoTo ErrHandler

'Set objWb = objXl.Workbooks.open("app.path & \kundreg\bokfaktura2.xls")' don't work

Set objWb = objXl.Workbooks.open("c:\kundreg\bokfaktura2.xls")
objWb.Worksheets("blad1").Range("F9") = TxtFNamn.Text
objWb.Worksheets("blad1").Range("G9") = TxtEftN.Text
objWb.Worksheets("blad1").Range("F10") = TxtAdr.Text
objWb.Worksheets("blad1").Range("F11") = TxtPostNr.Text
objWb.Worksheets("blad1").Range("G11") = TxtPostAdr.Text
objWb.Worksheets("blad1").Range("I4") = MaskEdBox1.Text

'objWb.SaveAs ("c:\kundreg\faktura\kund.xls & date.xls")
'objWb.SaveAs ("app.path & \kundreg\faktura\kund & "I4") ' don't work


ExitHandler:
On Error Resume Next
Set objWb = Nothing
objXl.Quit
Set objXl = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description, vbExclamation
Resume ExitHandler

Recommended Answers

All 22 Replies

Here is how to open excel file
Does line 6 work?

yes line 6 works

yes line 6 works

xlTmp.Workbooks.open ("app.path & \kundreg\bokfaktura2.xls") 'don't work
should be:
xlTmp.Workbooks.open ("app.path" & "\kundreg\bokfaktura2.xls") 'don't work

ddanbe I work in VB 6

yes line 6 works

xlTmp.Workbooks.open ("app.path" & "\kundreg\bokfaktura2.xls")
can't find app.path

app.path shouldn't have quotes around it. Try
xlTmp.Workbooks.open (App.Path & "\kundreg\bokfaktura2.xls"). If that doesn't work, then try putting App.Path & "\kundreg\bokfaktura2.xls" in a string variable first, and then passing the string variable to the open command
xlTmp.Workbooks.open (myStringVariable)

cgeier

can't find app.path
c:\kundreg\bokfaktura2.xls

What operating system (XP, vista, Win 7)?

win 7
evry thing in the program is working with app.path

So it's working now? Here is some code that can be used for testing purposes:

Create a form called "Form1" and add a button. Rename the button to "runBtn".

Form1.frm

Private Sub runBtn_Click()


    Dim userVar As Long


    'add reference to Microsoft.Excel; 
    'Project => Reference =>
    'Microsoft Excel ... Object Library

    Dim objX1 As New Excel.Application
    Dim objWb As Excel.Workbook

    'add reference to Microsoft Scripting Runtime;
    'Project => Reference =>
    'Microsoft Scripting Runtime

    Dim fso As New FileSystemObject


    Dim fn1, fn2, fn3 As String
    Dim myCurrentDir As String

    Dim retVal

    Dim xlTmp As Excel.Application
    Set xlTmp = Excel.Application


    MsgBox ("UserProfile Folder: " & fGetSpecialFolder(CSIDL_PROFILE))
    MsgBox ("My Documents: " & fGetSpecialFolder(CSIDL_PERSONAL))

    MsgBox ("All User Documents: " & fGetSpecialFolder(CSIDL_COMMON_DOCUMENTS))

    ' "\" may or may not exist at end of App.Path
    If Right$(App.Path, 1) = "\" Then
        myCurrentDir = App.Path
    Else
        myCurrentDir = App.Path & "\"
    End If

    fn1 = "C:\kundreg\bokfaktura2.xls"
    fn2 = App.Path & "\kundreg\blkfaktura2.xls"

    fn3 = myCurrentDir & "kundreg\blkfaktura2.xls" 'use this one

    'check to see if file exists
    If (fso.FileExists(fn1) = False) Then
       retVal = MsgBox("fn1 File: '" & fn1 & "' does not exist. Exiting.", vbExclamation, "Error")
       'Return
    Else
        xlTmp.Workbooks.Open (fn1)
    End If

    If (fso.FileExists(fn2) = False) Then
       retVal = MsgBox("fn2 File: '" & fn2 & "' does not exist.", vbExclamation, "Error")
       'Return
    Else
        xlTmp.Workbooks.Open (fn2)
    End If

    If (fso.FileExists(fn3) = False) Then
       retVal = MsgBox("fn3 File: '" & fn3 & "' does not exist.", vbExclamation, "Error")
       'Return
    Else
        xlTmp.Workbooks.Open (fn3)
    End If

End Sub

Here is some code to retrieve the location of special folders such as "My Documents".

Utilities.bas

'Utilities.bas
'Module Code

Option Explicit
Declare Function SHGetSpecialFolderLocation Lib "Shell32.dll" _
(ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Declare Function SHGetPathFromIDList Lib "Shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long
Public Type SHITEMID
    cb As Long
    abID As Byte
End Type

Public Type ITEMIDLIST
    mkid As SHITEMID
End Type

Public Const MAX_PATH As Integer = 260

Public Const CSIDL_DESKTOP = &H0                       'Desktop - virtual folder
Public Const CSIDL_INTERNET = &H1                      'IE (icon on desktop)
Public Const CSIDL_PROGRAMS = &H2                      'Start Menu\Programs
Public Const CSIDL_CONTROLS = &H3                      'Control Panel - virtual folder
Public Const CSIDL_PRINTERS = &H4                      'Printers - virtual folder
Public Const CSIDL_PERSONAL = &H5                      'My Documents
Public Const CSIDL_FAVORITES = &H6                     'Favorites
Public Const CSIDL_STARTUP = &H7                       'Start Menu\All Programs\Startup
Public Const CSIDL_RECENT = &H8                        'Recent Documents
Public Const CSIDL_SENDTO = &H9                        'SendTo
Public Const CSIDL_BITBUCKET = &HA                     'Recycle Bin - virtual folder
Public Const CSIDL_STARTMENU = &HB                     'Start Menu
Public Const CSIDL_MYDOCUMENTS = &HC                   'My Documents
Public Const CSIDL_MYMUSIC = &HD                       'My Documents\My Music
Public Const CSIDL_MYVIDEO = &HE                       'My Documents\My Video
Public Const CSIDL_DESKTOPFOLDER = &H10                'Desktop folder
Public Const CSIDL_DRIVES = &H11                       'My Computer - virtual folder
Public Const CSIDL_NETWORK = &H12                      'Network Neighborhood - virtual
Public Const CSIDL_NETHOOD = &H13                      'NetHood / Network Places
Public Const CSIDL_FONTS = &H14                        'Windows\Fonts folder
Public Const CSIDL_TEMPLATES = &H15                    'Templates
Public Const CSIDL_COMMON_STARTMENU = &H16             'All Users Start Menu
Public Const CSIDL_COMMON_PROGRAMS = &H17              'All Users Start Menu\Programs
Public Const CSIDL_COMMON_STARTUP = &H18               'All Users Start Menu\All Programs\Startup
Public Const CSIDL_COMMON_DESKTOPFOLDER = &H19         'All Users Desktop
Public Const CSIDL_APPDATA = &H1A                      'AppData folder
Public Const CSIDL_PRINTHOOD = &H1B                    'PrintHood
Public Const CSIDL_LOCAL_APPDATA = &H1C                'Local Settings\Application Data; AppData\Local
Public Const CSIDL_ALTSTARTUP = &H1D                   'non-localized startup
Public Const CSIDL_COMMON_ALTSTARTUP = &H1E            'non-localized startup - all users
Public Const CSIDL_COMMON_FAVORITES = &H1F             'All users favorites
Public Const CSIDL_INTERNET_CACHE = &H20               'Temporary internet files folder
Public Const CSIDL_COOKIES = &H21                      'cookies folder
Public Const CSIDL_HISTORY = &H22                      'Internet history
Public Const CSIDL_COMMON_APPDATA = &H23               'Application Data
Public Const CSIDL_WINDOWS = &H24                      'Windows folder
Public Const CSIDL_SYSTEM = &H25                       'Windows system folder
Public Const CSIDL_PROGRAM_FILES = &H26                'Program files
Public Const CSIDL_MYPICTURES = &H27                   'My Documents\My Pictures
Public Const CSIDL_PROFILE = &H28                      'USERPROFILE
Public Const CSIDL_SYSTEMX86 = &H29                    'x86 system folder - RISC
Public Const CSIDL_PROGRAM_FILESX86 = &H2A             'Common files folder
Public Const CSIDL_PROGRAM_FILES_COMMON = &H2B         'x86 common files folder - RISC
Public Const CSIDL_PROGRAM_FILES_COMMONX86 = &H2C      'x86 program files\common - RISC
Public Const CSIDL_COMMON_TEMPLATES = &H2D             'Shared/Public Templates
Public Const CSIDL_COMMON_DOCUMENTS = &H2E             'Shared/Public Documents
Public Const CSIDL_COMMON_ADMINTOOLS = &H2F            'Administrative Tools
Public Const CSIDL_ADMINTOOLS = &H30                   'Administrative Tools
Public Const CSIDL_CONNECTIONS = &H31                  'Network and Dial-up connections
Public Const CSIDL_COMMON_MUSIC = &H35                 'Shared/Public Music
Public Const CSIDL_COMMON_PICTURES = &H36              'Shared/Public Video
Public Const CSIDL_COMMON_VIDEO = &H37                 'Shared/Public Video
Public Const CSIDL_RESOURCES = &H38                    'System resource folder
Public Const CSIDL_RESOURCES_LOCALIZED = &H39          'localized system resource folder
Public Const CSIDL_COMMON_OEM_LINKS = &H3A             'links to OEM specific apps
Public Const CSIDL_CDBURN_AREA = &H3B                  'CD Burning folder
Public Const CSIDL_COMPUTERSNEARME = &H3D              'Computers Near Me
Public Const CSIDL_FLAG_PER_USER_INIT = &H800
Public Const CSIDL_FLAG_NO_ALIAS = &H1000
Public Const CSIDL_FLAG_DONT_VERIFY = &H4000
Public Const CSIDL_FLAG_CREATE = &H8000
Public Const CSIDL_FLAG_MASK = &HFF00


Public Function fGetSpecialFolder(CSIDL As Long) As String
    Dim sPath As String
    Dim IDL As ITEMIDLIST
    '
    ' Retrieve info about system folders such as the "Recent Documents" folder.
    ' Info is stored in the IDL structure.
    '
    fGetSpecialFolder = ""
    'If SHGetSpecialFolderLocation(Form1.hWnd, CSIDL, IDL) = 0 Then
    If SHGetSpecialFolderLocation(Form1.hWnd, CSIDL, IDL) = 0 Then
        '
        ' Get the path from the ID list, and return the folder.
        '
        sPath = Space$(MAX_PATH)
        If SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath) Then
            fGetSpecialFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1) & ""
        End If
    End If
End Function

Most of "Utilities.bas" was taken from here

It is better practice to store your data in "My Documents" or "AppData"--in my opinion.

it stops at line

Private Sub runBtn_Click()
Dim userVar As Long
'add reference to Microsoft.Excel;
'Project => Reference =>
'Microsoft Excel ... Object Library

Dim objXl As New Excel.Application 'stops
Dim objWb As Excel.Workbook
'add reference to Microsoft Scripting Runtime;
'Project => Reference =>
'Microsoft Scripting Runtime
Dim fso As New FileSystemObject
Dim fn1, fn2, fn3 As String
Dim myCurrentDir As String
Dim retVal
Dim xlTmp As Excel.Application
Set xlTmp = Excel.Application

What version of Excel are you using?

now it's stops at line 12

user is not defined

It works for me. Please post the code that you are using. Perhaps you omitted something while copying my code.

Did you add the references?

yes

This code should work.

Private Sub runBtn_Click()

    'add reference to Microsoft.Excel; Project => Reference =>
    'Microsoft Excel ... Object Library

    Dim excelApp As Excel.Application
    Dim excelWB As Excel.workbook
    Dim excelWS As Excel.Worksheet

    'name of desired worksheet
    Dim wsName As String
    wsName = "blad1"

    'add reference to Microsoft Scripting Runtime; Project => Reference =>
    'Microsoft Scripting Runtime

    Dim fso As New FileSystemObject


    Dim fn As String
    Dim myCurrentDir As String

    Dim retVal

    'check to see if backslash already exists
    'if not, add it
    If Right$(App.Path, 1) = "\" Then
        myCurrentDir = App.Path
    Else
        myCurrentDir = App.Path & "\"
    End If

    fn = myCurrentDir & "kundreg\blkfaktura2.xls" 'use this one

    If (fso.FileExists(fn) = False) Then
       retVal = MsgBox("File: '" & fn & "' does not exist.", vbSystemModal + vbExclamation, "Error")
       Return
    Else
        retVal = MsgBox("File: '" & fn & "' found. Opening...", vbSystemModal + vbInformation, "File Found")

        Set excelApp = CreateObject("Excel.Application")
        excelApp.Visible = True 'make excel visible

        Set excelWB = excelApp.Workbooks.Open(fn) 'open the excel file

        Set excelWS = FindWorkSheet(excelWB, wsName) 'see if worksheet exists

        'if worksheet doesn't exist, clean up and exit
        If (excelWS Is Nothing) Then
            retVal = MsgBox("Worksheet: '" & wsName & "' does not exist in '" & fn & "'. Exiting.", vbSystemModal + vbExclamation, "Error")
            GoTo CleanUp
        End If


        'from http://support.microsoft.com/kb/247412
        'set cell F9 to TestF9

        excelWS.Range("F9").Value = "TestF9"
        excelWS.Range("G9").Value = "TestG9"


        'http://vbcity.com/forums/t/145906.aspx
        'setting DisplayAlerts = false prevents prompting
        'for overwriting the file
        excelApp.DisplayAlerts = False 'turn off error messages
        excelWB.SaveAs (fn)
        excelApp.DisplayAlerts = True 'turn error messages back on


CleanUp:
        'clean up
        Set excelWS = Nothing
        excelWB.Close
        excelApp.Quit




    End If

End Sub

Private Function FindWorkSheet(ByVal workbook As Excel.workbook, ByVal sheetname As String)
    'function taken from http://www.vb-helper.com/howto_write_excel.html

    Dim ws As Excel.Worksheet

    For Each ws In workbook.Sheets
        If (ws.Name = sheetname) Then
            Set FindWorkSheet = ws
            Exit Function
        End If
    Next ws

    Set FindWorkSheet = Nothing
End Function

Hi again

I shall test it

Hi cegeir

This works for me now, and I shall test you code tommorow

Dim objXl As New Excel.Application
    Dim objWb As Excel.Workbook
    Dim xlTmp As Excel.Application
    Set xlTmp = Excel.Application

    Dim fso As New FileSystemObject
    Dim fn1, fn2, fn3 As String
    Dim myCurrentDir As String
    Dim retVal

    If Right$(App.Path, 1) = "\" Then
       myCurrentDir = App.Path
  Else
       myCurrentDir = App.Path & "\"
End If


fn3 = myCurrentDir & "\faktura\bokfaktura2.xls"

If (fso.FileExists(fn3) = False) Then
retVal = MsgBox("fn3 File: '" & fn3 & "' does not exist.", vbExclamation, "Error")
'Return
Else


    On Error GoTo ErrHandler

    Set objWb = objXl.Workbooks.open(fn3)

        objXl.Visible = True

    objWb.Worksheets("blad1").Range("F9") = TxtFNamn.Text
    objWb.Worksheets("blad1").Range("G9") = TxtEftN.Text
    objWb.Worksheets("blad1").Range("F10") = TxtAdr.Text
    objWb.Worksheets("blad1").Range("F11") = TxtPostNr.Text
    objWb.Worksheets("blad1").Range("G11") = TxtPostAdr.Text
    objWb.Worksheets("blad1").Range("I4") = MaskEdBox1.Text

ExitHandler:
    On Error Resume Next
    Set objWb = Nothing
    objXl.Quit
    Set objXl = Nothing
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler


        objWb.Close
        objWb.Quit

        objXl.Quit
        objXl.Visible = False

You may also want to read about early bindind vs late binding Click Here.

"If you will be using a component that you do not redistribute with your setup package, and cannot be assured of the exact version you will be communicating with at run-time, you should pay special attention to early bind to an interface that is compatible with all versions of the component, or (in some cases) use late binding to call a method that may exist in a particular version and fail gracefully if that method is not present in the version installed on the client system."

"Microsoft Office applications provide a good example of such COM servers. Office applications will typically expand their interfaces to add new functionality or correct previous shortcomings between versions. If you need to automate an Office application, it is recommended that you early bind to the earliest version of the product that you expect could be installed on your client's system. For example, if you need to be able to automate Excel 95, Excel 97, Excel 2000, and Excel 2002, you should use the type library for Excel 95 (XL5en32.olb) to maintain compatibility with all three versions."

Click Here for another resource.

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.