Consulting

Results 1 to 4 of 4

Thread: Debug error due to StPath

  1. #1

    Debug error due to StPath

    Hi all,

    I am getting a debug error on the below VBA that i am sure is to to with the fact the Excel spreadsheet it on a public networked drive. It seems to be always looking at my C drive so going like this C:\Colin\\1035492-f01\shared$\Public\Colin\test.xlsx

    enviro = CStr(Environ("USERPROFILE"))
    'the path of the workbook
    strPath = enviro & "\\1035492-f01\shared$\Public\Colin\test.xlsx"
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err <> 0 Then
    Application.StatusBar = "Please wait while Excel source is opened ... "
    Set xlApp = CreateObject("Excel.Application")
    bXStarted = True
    End If
    On Error GoTo 0
    'Open the workbook to input the data
    Set xlWB = xlApp.Workbooks.Open(strPath)
    Set xlSheet = xlWB.Sheets("Sheet1")

    Can you help?

    Many thanks in advance

  2. #2
    It will always look at the C: drive if you use CStr(Environ("USERPROFILE")) in your strPath string as that will be a C drive location e.g. "C:\Users\Colin"
    set strpath to the actual path of the network location in question which might be "\\1035492-f01\shared$\Public\Colin\test.xlsx"
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    Quote Originally Posted by gmayor View Post
    It will always look at the C: drive if you use CStr(Environ("USERPROFILE")) in your strPath string as that will be a C drive location e.g. "C:\Users\Colin"
    set strpath to the actual path of the network location in question which might be "\\1035492-f01\shared$\Public\Colin\test.xlsx"
    Ah so something like this?

    enviro = CStr(Environ("\\1035492-f01\shared$\Public\Colin\test.xlsx"))
    'the path of the workbook
    strPath = enviro & "\\1035492-f01\shared$\Public\Colin\test.xlsx"
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err <> 0 Then
    Application.StatusBar = "Please wait while Excel source is opened ... "
    Set xlApp = CreateObject("Excel.Application")
    bXStarted = True
    End If
    On Error GoTo 0
    'Open the workbook to input the data
    Set xlWB = xlApp.Workbooks.Open(strPath)
    Set xlSheet = xlWB.Sheets("Sheet1")

    I have done the above but it's not writing to the excel file, Is what i have done correct?

    Also anyway i can change it so it doesn't open the workbook but add's the information anyway?

    Thanks for the help so far.
    Last edited by oneblondebro; 03-22-2017 at 04:15 AM.

  4. #4
    Forget all about Environ, which has a specific role that is not required here. The path is simply strPath = "\\1035492-f01\shared$\Public\Colin\test.xlsx"
    If you want to get 'Colin' using Environ, assuming the username is Colin and not Colin+Surname then

    strUser = CStr(Environ("USERNAME"))
    strPath = "\\1035492-f01\shared$\Public\" & strUser & "\test.xlsx"

    Dim strUser As String
    Dim strPath As String
    Dim xlApp As Object
    Dim xlWB As Object
    Dim xlSheet As Object
    Dim bXStarted As Boolean
    Dim fso As Object
        Set fso = CreateObject("Scripting.FileSystemObject")
        strUser = CStr(Environ("USERNAME"))
        'the path of the workbook
        strPath = "\\1035492-f01\shared$\Public\" & strUser & "\test.xlsx"
        If Not fso.FileExists(strPath) Then
            MsgBox "The workbook '" & strPath & "' doesn't exist"
            Exit Sub
        End If
        On Error Resume Next
        Set xlApp = GetObject(, "Excel.Application")
        If Err <> 0 Then
            Application.StatusBar = "Please wait while Excel source is opened ... "
            Set xlApp = CreateObject("Excel.Application")
            bXStarted = True
        End If
        On Error GoTo 0
        'Open the workbook to input the data
        Set xlWB = xlApp.Workbooks.Open(strPath)
        Set xlSheet = xlWB.Sheets("Sheet1")
    You can address the worksheet without opening the workbook, but it is altogether less tolerant of coding errors.
    The following function assumes a pre-existing worksheet with a header row at row 1 and three columns (you can have more columns and values as required, but always the same number of items in the string strValues even if some of those strings are empty.
    strRange is the worksheet name. strValues is a string in the format below, where strValue1, strValue2, strvalue 3 etc are the variable that you want to write to the worksheet

    strValues = strValue1 & "', '" & strValue2 & "', '" & strValue3 'etc

    Sub Example()
    Dim strUser As String
    Dim strPath As String
    Dim strValues As String
    Dim strValue1 As String
    Dim strValue2 As String
    Dim strValue3 As String
    Dim fso As Object
        Set fso = CreateObject("Scripting.FileSystemObject")
        strUser = CStr(Environ("USERNAME"))
        'the path of the workbook
        strPath = "\\1035492-f01\shared$\Public\" & strUser & "\test.xlsx"
        If Not fso.FileExists(strPath) Then
            MsgBox "The workbook '" & strPath & "' doesn't exist"
            Exit Sub
        End If
        On Error Resume Next
        'get the values
        strValue1 = "Item1"
        strValue2 = "Item2"
        strValue3 = "Item3"
        'write them to the sheet
        strValues = strValue1 & "', '" & strValue2 & "', '" & strValue3 'etc
        WriteToWorksheet strPath, "Sheet1", strValues
    End Sub
    
    Private Function WriteToWorksheet(strWorkbook As String, _
                                     strRange As String, _
                                     strValues As String)
    Dim ConnectionString As String
    Dim strSQL As String
    Dim CN As Object
        ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                           "Data Source=" & strWorkbook & ";" & _
                           "Extended Properties=""Excel 12.0 Xml;HDR=YES;"";"
        strSQL = "INSERT INTO [" & strRange & "$] VALUES('" & strValues & "')"
        Set CN = CreateObject("ADODB.Connection")
        Call CN.Open(ConnectionString)
        Call CN.Execute(strSQL, , 1 Or 128)
        CN.Close
        Set CN = Nothing
    lbl_Exit:
        Exit Function
    End Function


    Public Function WriteToWorksheet(strWorkbook As String, _
                                     strRange As String, _
                                     strValues As String)
    Dim ConnectionString As String
    Dim strSQL As String
    Dim CN As Object
        ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                           "Data Source=" & strWorkbook & ";" & _
                           "Extended Properties=""Excel 12.0 Xml;HDR=YES;"";"
        strSQL = "INSERT INTO [" & strRange & "$] VALUES('" & strValues & "')"
        Set CN = CreateObject("ADODB.Connection")
        Call CN.Open(ConnectionString)
        Call CN.Execute(strSQL, , 1 Or 128)
        CN.Close
        Set CN = Nothing
    lbl_Exit:
        Exit Function
    End Function
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •