Studio session checker (framework per system)

Outputs a series of files [USER_FolderID]@[ComputerID]-COUNT_####.txt

With list of sessions and last accessed dates

''Const strBrk = vbCr & "Bluebeam sessions all users-------------------------------------------" & vbCr Const StrOutFold = "\\corp.ktgy.com\global\Corporate\Technology\_DT\DATA-OUTPUT\Bluebeam-Studio\" Dim msg 'As String ''String message Main ''MsgBox "Done." Sub Main() ''check for Bluebeam sessions Dim FSO 'As New FileSystemObject ''File system access Dim ofold 'As Folder ''primary folder Dim oufold 'As Folder ''User folders Dim osFold 'As Folder ''sub folders Dim SH 'As WshShell ''Windows shell Dim strFP 'As String ''File path for studio Dim strUser 'As String ''User ID Dim StrCompN 'As String ''Computer ID Dim StrUC 'As String ''User+ Comp Dim ttl ''as Integer ''Totoal count of studio files ''Dim ofileTxt As TextStream ''Text stream Set FSO = CreateObject("Scripting.FileSystemObject") Set SH = CreateObject("WScript.Shell") ''set shell object StrCompN = CreateObject("WScript.Network").ComputerName Set ofold = FSO.GetFolder("C:\Users\") For Each oufold In ofold.SubFolders ''Iterate C:\Users\[Folders] msg = "" ''Clean msg ********************* ttl = 0 ''Reset total count to 0 strUser = "": strUser = oufold.Name ''User folder name ''If strUser Like "ron*" Then Stop ''DEBUG******************************* strFP = oufold.Path & "\AppData\local\Revu\data\Sessions\studio.bluebeam.com\" ''Path of Studio files StrUC = rPad(String(32, " "), "USER:" & strUser) & _ rPad(String(20, " "), "COMPUTER:" & StrCompN) ''add User & computer name as line header If Not FSO.FolderExists(strFP) Then ''Return NONE if folder does not exist msgadd StrUC & rPad(String(24, " "), "STUDIO:NONE") Else ''Else explore folders Set ofold = FSO.GetFolder(strFP) ''Get subfolders in studio For Each osFold In ofold.SubFolders ''For each subfolder msgadd StrUC & rPad(String(22, " "), "SessionID:" & osFold.Name) ''Add session ID based on subfolder name ''Document Count by subfolders in session msgadd rPad(String(14, " "), "FileCT:" & lPad("0000", FSO.GetFolder(osFold.Path & "\Documents\").SubFolders.count)) ttl = ttl + FSO.GetFolder(osFold.Path & "\Documents\").SubFolders.count ''Add total count of subfolders from each session dlast = 0: dlast = osFold.DateLastModified ''Format Last Accessed Date for Folder msgadd "LAST_ACCESSED:" ''Format last accessed date msgadd Year(dlast) & _ "-" & lPad("00", Month(dlast)) & _ "-" & lPad("00", Day(dlast)) & _ "t" & lPad("00", Hour(dlast)) & _ lPad("00", Minute(dlast)) msgadd vbCr ''Add RETURN tof next MSG for other Subfolders(Sessions) Next ''Next subfolder in the setssion End If ''Not FSO.FolderExists(strFP) ''end if session folders exist ''Create text file to write Set ofileTxt = _ FSO.CreateTextFile(StrOutFold & strUser & "@" & StrCompN & "-Count_" & Right("0000" & ttl, 4) & ".TXT", _ True, _ False) ''Name using destination folder, User@computer-COUNT_####.txt ofileTxt.Write msg ''Write MSG as file ofileTxt.Close ''Close text stream Next ''oufold ''nest object user folder ''Next user ''Debug.Print msg End Sub Sub msgadd(ByRef strMsg) msg = msg & strMsg End Sub Function lPad(strPad, value) ''lpad for padding to the left - keep digits to right I.e. Numbers lPad = Right(strPad & value, Len(strPad)) If Len(value) > Len(strPad) Then lPad = value End Function Function rPad(strPad, value) ''rpad for padding digits to right i.e. Text rPad = left(value & strPad, Len(strPad)) If Len(value) > Len(strPad) Then rPad = value End Function

Comments

Popular posts from this blog

Revit area plans adding new types and references (Gross and rentable)

Powerpoint countdown and current time in slides VBA

Revit 2019 and up tab colorizer