Page 4 of 4 FirstFirst 1234
Results 46 to 56 of 56
  1. #46
    pkstormy's Avatar
    pkstormy is offline Access/SQL Server Expert
    Windows XP Access 2003
    Join Date
    Mar 2010
    Location
    Madison
    Posts
    682
    Here's another modification to the script. Included is code to actually write to the SQL Server tables. It's used for a program that track's Who's In/Out so all of our staff can easily see who is Logged In or Logged Out. It writes "LoggedIn" to the LoginStatus field in the dbo.Users table on SQL Server when the user logs into the computer (using Windows Authentication - note the user must also have SQL Server permissions.) Our network admin added this vb script as part of the user's login script when they log into their computer. There's another vb script which writes "LockedWorkStation" when the work station is locked and another recording the LoggedOut time. Note that the code also writes to a dbo.UsersLogHistory table to create total Login/Logout times (LoggedOut time minus <any workstation locked records> minus LoggedIn time).

    Even though network admin can generate user login/logout times in their logs, it's nice to automatically track this in a db and have a front-end where everyone can see (real-time) who's logged in or out.

    Set WSNet = CreateObject("WScript.Network")
    GetUser = WSNet.UserName
    varComputerName = WSNet.ComputerName
    Set WSNet = Nothing
    Set MyConn = CreateObject("ADODB.Connection")
    Set RS = CreateObject("ADODB.Recordset")
    MyConn.open = "Provider=SQLOLEDB;Data Source=144.92.222.333;Initial Catalog=WhosInOut;Integrated Security=SSPI"
    'Note: use Integrated Security=SSPI for Windows Authentication
    Dim rst
    set rst = createobject("ADODB.Recordset")
    queryString = "SELECT * FROM dbo.Users where LoginID = '" & GetUser & "'"
    'rst.Open queryString, MyConn, adopenkeyset, adlockreadonly
    rst.Open queryString, MyConn
    Dim CC
    CC = 0
    while not rst.eof
    CC = CC + 1


    rst.movenext
    wend
    RST.Close
    Set RST = Nothing
    if CC < 1 then
    Dim LogID
    LogID = inputbox("Your LoginID was not found for the WhosIn/Out program (one time entry only), please enter your login name: (you will not be asked this again.) - contact Paul Kohn or Nick Wiley if you have any questions." & vbcrlf & "Please enter your loginID that use to login to your computer:")
    if LogID = "" then wscript.quit
    Dim FullName
    FullName = inputbox("Now Please enter your FULL name:")
    if FullName = "" then wscript.quit
    SQL = "INSERT INTO dbo.Users(LoginID, UserFullName) Select '" & LogID & "', '" & FullName & "'"
    MyConn.execute(SQL)
    SQL = "UPDATE dbo.Users SET LoginStatus ='" & "LoggedIn" & "' WHERE LoginID ='" & GetUser & "'"
    MyConn.execute(SQL)
    SQL = "UPDATE dbo.Users SET ComputerName ='" & varComputerName & "' WHERE LoginID ='" & GetUser & "'"
    MyConn.execute(SQL)
    SQL = "INSERT INTO dbo.UsersLogHistory(LoginID, LoginStatus) Select '" & GetUser & "', 'LoggedIn'"
    MyConn.execute(SQL)
    MyConn.Close
    msgbox "Thank You. " & LogID & " has been registered. If you are a WhosIn/Out tester, you're login/logout status will show for others (and you can see theirs)."
    else
    SQL = "UPDATE dbo.Users SET LoginStatus ='" & "LoggedIn" & "' WHERE LoginID ='" & GetUser & "'"
    MyConn.execute(SQL)
    SQL = "UPDATE dbo.Users SET ComputerName ='" & varComputerName & "' WHERE LoginID ='" & GetUser & "'"
    MyConn.execute(SQL)
    SQL = "INSERT INTO dbo.UsersLogHistory(LoginID, LoginStatus) Select '" & GetUser & "', 'LoggedIn'"
    MyConn.execute(SQL)
    MyConn.Close
    end if
    Set MyConn = Nothing
    Last edited by pkstormy; 03-02-2013 at 09:41 PM.

  2. #47
    Njbuyer1 is offline Novice
    Windows 7 32bit Access 2010 32bit
    Join Date
    Feb 2014
    Posts
    1
    Hello,

    I attempt to use the below code to use a cloned copy of my db that I want to open automatically. The script will clone the DB perfectly and rename it the way it is supposed to. However, Access will open but will not open the "newName" file. Any suggestions?

    Set WshNetwork = CreateObject("WScript.Network")
    GetUser = WshNetwork.UserName
    Set WshNetwork = Nothing
    LUName = "T:\ConAdmin2\Kevin McKernan\ZR53DL DATBASE STOREHOUSE\ZR53DL CLEANUP FINAL WORKING COPY 222014.accdb"
    'Note: or LUName = "UNC Name"
    oldname = LUName
    newName = Replace(LUName, ".accdb", "_") & GetUser & ".accdb"
    retval = 0
    Dim objFSO
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    retval = objFSO.CopyFile(oldname, newName, true)
    Set objFSO = Nothing

    'now it just simply opens the cloned copy (ie. PKSampleXP<LoginID>.mde)
    Dim objShell
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run "msaccess.exe" & newName
    Set objShell = Nothing

  3. #48
    Dunro is offline Advanced Beginner
    Windows 7 32bit Access 2010 32bit
    Join Date
    Feb 2011
    Location
    Toronto, Canada
    Posts
    39
    Quote Originally Posted by Njbuyer1 View Post
    I attempt to use the below code to use a cloned copy of my db that I want to open automatically. The script will clone the DB perfectly and rename it the way it is supposed to. However, Access will open but will not open the "newName" file. Any suggestions?
    ...
    LUName = "T:\ConAdmin2\Kevin McKernan\ZR53DL DATBASE STOREHOUSE\ZR53DL CLEANUP FINAL WORKING COPY 222014.accdb"
    Could it be due to the spaces in the file name? (See posts further above in the thread which discuss this)

    My template has spaces, but doesn't use shell to run Access. I do something along these lines (I've excluded irrelevant code):

    Code:
    dim newAccess as Object
    set newAccess = CreateObject("Access.Application")
    newAccess.AutomationSecurity = 1 ' msoAutomationSecurityLow - Enable Macros --- may not be necessary for you?
    newAccess.OpenCurrentDatabase newName, True
    newAccess.UserControl = true
    Good luck!

  4. #49
    Creamer is offline Novice
    Windows 7 64bit Access 2010 64bit
    Join Date
    Feb 2014
    Posts
    3
    If your path has spaces in it, then add chr(34) around newname like in the following to open Access:

    objShell.Run "MSAccess.exe " & chr(34) & newName & chr(34)

  5. #50
    upzaw2000 is offline Novice
    Windows 7 64bit Access 2010 64bit
    Join Date
    Oct 2014
    Posts
    4
    My script is copying the file but is not opening the database at the end, instead its throwing an error.... any idea?

    Ive tried dozens of combos now with spacing in the file locations for both the table as well as the access.exe file. Ive tried the Chr 24 suggestion. Everything it seems!

    I am getting an error 0x80041002
    Line: 14
    Source: (null)

    Set WshNetwork = CreateObject("WScript.Network")
    GetUser = WshNetwork.UserName
    Set WshNetwork = Nothing
    LUName = "M:\xxxxxxx\BACK END TABLES\QC.accde"
    oldname = LUName
    newName = Replace(LUName, ".accde", "") & GetUser & ".accde"
    retval = 0
    Dim objFSO
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    retval=objFSO.CopyFile(oldname, newName, True)
    Set objFSO = Nothing
    Dim objShell
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run "MSACCESS.EXE" & newName
    Set objShell = Nothing

  6. #51
    orange's Avatar
    orange is online now Moderator
    Windows XP Access 2003
    Join Date
    Sep 2009
    Location
    Ottawa, Ontario, Canada; West Palm Beach FL
    Posts
    16,716
    Copy of pkstormy's code in post 46 (processed by SmartIndent) to help with readability

    Code:
      Set WSNet = CreateObject("WScript.Network")
        GetUser = WSNet.UserName
        varComputerName = WSNet.ComputerName
        Set WSNet = Nothing
        Set MyConn = CreateObject("ADODB.Connection")
        Set rs = CreateObject("ADODB.Recordset")
        MyConn.Open = "Provider=SQLOLEDB;Data Source=144.92.222.333;Initial Catalog=WhosInOut;Integrated Security=SSPI"
        'Note: use Integrated Security=SSPI for Windows Authentication
        Dim rst
        Set rst = CreateObject("ADODB.Recordset")
        QueryString = "SELECT * FROM dbo.Users where LoginID = '" & GetUser & "'"
        'rst.Open queryString, MyConn, adopenkeyset, adlockreadonly
        rst.Open QueryString, MyConn
        Dim CC
        CC = 0
        While Not rst.EOF
            CC = CC + 1
            rst.MoveNext
        Wend
        rst.Close
        Set rst = Nothing
        If CC < 1 Then
            Dim LogID
            LogID = InputBox("Your LoginID was not found for the WhosIn/Out program (one time entry only), please enter your login name: (you will not be asked this again.) - contact Paul Kohn or Nick Wiley if you have any questions." & vbCrLf & "Please enter your loginID that use to login to your computer:")
            If LogID = "" Then wscript.Quit
            Dim FullName
            FullName = InputBox("Now Please enter your FULL name:")
            If FullName = "" Then wscript.Quit
            SQL = "INSERT INTO dbo.Users(LoginID, UserFullName) Select '" & LogID & "', '" & FullName & "'"
            MyConn.Execute (SQL)
            SQL = "UPDATE dbo.Users SET LoginStatus ='" & "LoggedIn" & "' WHERE LoginID ='" & GetUser & "'"
            MyConn.Execute (SQL)
            SQL = "UPDATE dbo.Users SET ComputerName ='" & varComputerName & "' WHERE LoginID ='" & GetUser & "'"
            MyConn.Execute (SQL)
            SQL = "INSERT INTO dbo.UsersLogHistory(LoginID, LoginStatus) Select '" & GetUser & "', 'LoggedIn'"
            MyConn.Execute (SQL)
            MyConn.Close
            MsgBox "Thank You. " & LogID & " has been registered. If you are a WhosIn/Out tester, you're login/logout status will show for others (and you can see theirs)."
        Else
            SQL = "UPDATE dbo.Users SET LoginStatus ='" & "LoggedIn" & "' WHERE LoginID ='" & GetUser & "'"
            MyConn.Execute (SQL)
            SQL = "UPDATE dbo.Users SET ComputerName ='" & varComputerName & "' WHERE LoginID ='" & GetUser & "'"
            MyConn.Execute (SQL)
            SQL = "INSERT INTO dbo.UsersLogHistory(LoginID, LoginStatus) Select '" & GetUser & "', 'LoggedIn'"
            MyConn.Execute (SQL)
            MyConn.Close
        End If
        Set MyConn = Nothing

  7. #52
    Dunro is offline Advanced Beginner
    Windows 7 32bit Access 2013
    Join Date
    Feb 2011
    Location
    Toronto, Canada
    Posts
    39
    Quote Originally Posted by upzaw2000 View Post
    My script is copying the file but is not opening the database at the end, instead its throwing an error.... any idea?

    Ive tried dozens of combos now with spacing in the file locations for both the table as well as the access.exe file. Ive tried the Chr 24 suggestion. Everything it seems!
    It really looks like an issue with spaces in the file path. The Chr 34 solution above should have helped. (I also don't see a Chr 24 in your current code...)

  8. #53
    Creamer is offline Novice
    Windows 7 64bit Access 2010 64bit
    Join Date
    Feb 2014
    Posts
    3

    Cool

    Quote Originally Posted by upzaw2000 View Post
    My script is copying the file but is not opening the database at the end, instead its throwing an error.... any idea?

    Ive tried dozens of combos now with spacing in the file locations for both the table as well as the access.exe file. Ive tried the Chr 24 suggestion. Everything it seems!

    I am getting an error 0x80041002
    Line: 14
    Source: (null)

    Set WshNetwork = CreateObject("WScript.Network")
    GetUser = WshNetwork.UserName
    Set WshNetwork = Nothing
    LUName = "M:\xxxxxxx\BACK END TABLES\QC.accde"
    oldname = LUName
    newName = Replace(LUName, ".accde", "") & GetUser & ".accde"
    retval = 0
    Dim objFSO
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    retval=objFSO.CopyFile(oldname, newName, True)
    Set objFSO = Nothing
    Dim objShell
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run "MSACCESS.EXE" & newName
    Set objShell = Nothing
    Hi,
    You are missing a space after .EXE and before the quote, and you do not have the chr(34) - you mentioned chr(24) incorrectly

    your line is : objShell.Run "MSACCESS.EXE" & newName

    it should be: objShell.Run "MSACCESS.EXE " & chr(34) & newName & chr(34)

  9. #54
    upzaw2000 is offline Novice
    Windows 7 64bit Access 2010 64bit
    Join Date
    Oct 2014
    Posts
    4
    Thank you all. I am now getting error:
    80070002
    The system cannot find the file specified.
    Line 14
    Char 1
    I tried several variations again with this code to see if it would work but it didn't. The file continues to get copied and uses my username correctly but when it should open that new file instead it gives me this error.

    Any ideas?

    PS: all the files are in the same folder together on my M: drive.

    Set WshNetwork = CreateObject("WScript.Network")
    GetUser = WshNetwork.UserName
    Set WshNetwork = Nothing
    LUName = "M:\xxxx\xxxx\xxxx\xxxx\xxxxx\xxxx\xxxx\xxxxxx\QC. accde"
    oldname = LUName
    newName = Replace(LUName, ".accde", "") & GetUser & ".accde"
    retval = 0
    Dim objFSO
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    retval=objFSO.CopyFile(oldname, newName, True)
    Set objFSO = Nothing
    Dim objShell
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run "C:\Program Files (x86)\Microsoft Office\Office14\MSACCESS.EXE " & chr(34) & newName & chr(34)
    Set objShell = Nothing

  10. #55
    Creamer is offline Novice
    Windows 7 64bit Access 2010 64bit
    Join Date
    Feb 2014
    Posts
    3
    Hi,

    your line:
    objShell.Run "C:\Program Files (x86)\Microsoft Office\Office14\MSACCESS.EXE " & chr(34) & newName & chr(34)

    should be:
    objShell.Run "MSACCESS.EXE " & chr(34) & newName & chr(34)

    I believe it is getting confused when there are spaces in the path. You should not need to specify the path to Access.

  11. #56
    IncidentalProgrammer is offline Competent Performer
    Windows XP Access 2007
    Join Date
    Aug 2014
    Location
    Texas
    Posts
    156
    I'd asked a question, but found out corporate/Citrix was my issue. Got it working now. This thing is awesome.

Page 4 of 4 FirstFirst 1234
Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 8
    Last Post: 08-11-2010, 09:20 PM
  2. launching migration script
    By MrGrinch12 in forum Programming
    Replies: 0
    Last Post: 06-23-2010, 08:28 PM
  3. VBA Script to run select query
    By pushpm in forum Programming
    Replies: 2
    Last Post: 05-06-2009, 08:36 AM
  4. Login Script
    By theITguy in forum Access
    Replies: 2
    Last Post: 03-06-2009, 03:37 AM
  5. Open Accesss DB by batch script
    By micada in forum Access
    Replies: 0
    Last Post: 06-10-2008, 02:33 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums