Thursday, October 16, 2014

Source code beautifier / syntax highlighter – convert code snippets to HTML « hilite.me

This is helpful : )

DFSR Backlog Checker - via WMI (Thnx stichl.at) - added IE to make interface cleaner.

strComputer = "localhost"
bConnectForeign = False
'''http://stichl.at/2012/11/quick-dfsr-backlog-count-with-vbscript/
Dim objIE, objShell, k, strIETitle, blnFlag

' Set IE display box title. Dashes ("-") are to move the Microsoft title
' appended to the title we specify out of view.
' blnFlag is set to False when the user closes the IE display box.
strIETitle = "Backlog" & String(40, "-")
blnFlag = True

Set objShell = CreateObject("WScript.Shell")

dim StrMsg
call Main

sub Main()

' Initialize display box with initial message
InitIE "Program Initializing"

    Set oWMIService = GetObject("winmgmts:\\" & strComputer & "\root\MicrosoftDFS")
    Set colRGroups = oWMIService.ExecQuery("SELECT * FROM DfsrReplicationGroupConfig")
    For Each oGroup in colRGroups
        AddMsg( "Replication Group: " & oGroup.ReplicationGroupName)
        Set colRGFolders = oWMIService.ExecQuery("SELECT * FROM DfsrReplicatedFolderConfig WHERE ReplicationGroupGUID='" & oGroup.ReplicationGroupGUID & "'")
        For Each oFolder in colRGFolders
            AddMsg( "  Folder: " & oFolder.ReplicatedFolderName)
            Set colRGConnections = oWMIService.ExecQuery("SELECT * FROM DfsrConnectionConfig WHERE ReplicationGroupGUID='" & oGroup.ReplicationGroupGUID & "'")
            For Each oConnection in colRGConnections
                If oConnection.Enabled = True Then
                    If oConnection.Inbound = True Then
                        if bConnectForeign then
                            numBackLog = getBackLogCount(oConnection.PartnerName, oConnection.ConnectionGUID)
                        else
                            numBackLog = getBackLogCount(strComputer, oConnection.ConnectionGUID)
                        end if
                        AddMsg( "    " & strComputer & " <-- span=""> & oConnection.PartnerName & " :: " & numBackLog   )                  
       Else                         
        numBackLog = getBackLogCount(strComputer, oConnection.ConnectionGUID)                         
        AddMsg( "    " & strComputer & " --> " & oConnection.PartnerName & " :: " & numBackLog)
                    End If
                End If
            Next
        Next
    Next
  MsgIE StrMsg
end Sub

Function getBackLogCount(strComputer, ConnectionGUID)
    Set oWMIService = GetObject("winmgmts:\\" & strComputer & "\root\MicrosoftDFS")
    Set oDfsIUI = oWMIService.ExecQuery("SELECT * FROM DfsrIdUpdateInfo WHERE ConnectionGuid = '" & ConnectionGUID & "'")
    numBacklog=0
    for each eDfsIUI in oDfsIUI
        numBackLog=numBackLog+1
    next
    getBackLogCount = numBackLog
End Function

Sub AddMsg(Message)
 strMsg=Strmsg & Message & VBCR
end sub

Sub MsgIE(ByVal strMsg)
    ' Subroutine to display message in IE box and detect when the
    ' box is closed by the program or the user.
    On Error Resume Next
    If (strMsg = "IE_Quit") Then
        blnFlag = False
        objIE.Quit
    Else
        objIE.Document.Body.InnerText = strMsg
        If (Err.Number <> 0) Then
            Err.Clear
            blnFlag = False
            Exit Sub
        End If
        objShell.AppActivate strIETitle
    End If
End Sub

Sub InitIE(ByVal strMsg)
    ' Subroutine to initialize the IE display box.
    Dim intWidth, intHeight, intWidthW, intHeightW
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.ToolBar = False
    objIE.StatusBar = False
    objIE.Resizable = False
    objIE.Navigate("about:blank")
    Do Until objIE.readyState = 4
        Wscript.Sleep 100
    Loop
    'intWidth = 400 ''objIE.document.ParentWindow.Screen.AvailWidth
    'intHeight = 600 ''objIE.document.ParentWindow.Screen.AvailHeight
    'intWidthW = objIE.document.ParentWindow.Screen.AvailWidth * .40
    'intHeightW = objIE.document.ParentWindow.Screen.AvailHeight * .05
    objIE.document.ParentWindow.resizeto 400, 600
    objIE.document.ParentWindow.moveto (intWidth - intWidthW)/2, (intHeight - intHeightW)/2
    objIE.document.Write " " & strMsg & " 
" 'objIE.document.ParentWindow.document.body.style.backgroundcolor = "LightBlue" 'objIE.document.ParentWindow.document.body.scroll="no" 'objIE.document.ParentWindow.document.body.style.Font = "10pt 'Courier New'" 'objIE.document.ParentWindow.document.body.style.borderStyle = "outset" 'objIE.document.ParentWindow.document.body.style.borderWidth = "4px" objIE.document.Title = strIETitle objIE.Visible = True Wscript.Sleep 100 objShell.AppActivate strIETitle End Sub

Monday, October 6, 2014

Nemetschek Acquires Bluebeam Software - D'ough Autodesk!



Firms Combine Their Efforts to Make Project Collaboration Accessible to Everyone






Nemetschek owns Archicad and all plan... Wishful thinking auto desk would but BlueBeam from Nemetschek .. I hope they will continue to provide the same great non-platform specific support they always have - only time will tell.

Bluebeam's award-winning PDF solutions are used by the world’s top architectural, engineering and construction firms, oil and gas companies, manufacturers, government agencies and municipalities to reduce paper usage by more than 85% and to increase productivity by over 60%.
http://www.nemetschek.com/en/home.html

Nemetschek AG: Home
Nemetschek AG includes detailed information about the company: company history, Investor Relations, press material, corporate brands, business units and much more."



'via Blog this'

Tuesday, September 9, 2014

Ding dong the DWF is dead... and playing DWF is likely going to lead to some fire drills when we begin to see issues... Bluebeam Anyone?!!

Is Design Review discontinued? - Page 4 - Autodesk Community: "Re: Is Design Review discontinued?
Options
09-19-2013 05:25 AM in reply to: O.Maille
Thank you for the question. I am not here to delude anyone. If you want an electronic review process, given the current state of Autodesk 360, Autodesk Design Review is still the way to go. But the original question was is Design Review being discontinued, and the answer is yes, it will eventually be replaced by Autodesk 360. Until that time, the 2013 version is available for download from the Autodesk site and works with the 2014 product line since the DWF format did not change.


Scott Sheppard
Program Manager
Autodesk Labs
Autodesk, Inc."



'via Blog this'



So the long answer backed up on multiple sites now from a conversation with a co-worker:















...what is bloating the PDF?  (Hint it is the DWF to PDF translation)


From Autodesk's lack of action over the past few years and now they are
abandoning 
further development of DESIGN REVIEW for the desktop in favor of
the cloud. DWF to us is dead. DWF itself I suspect will disappear.




from:


http://labs.blogs.com/its_alive_in_the_lab/2014/02/vpipg-cto-brian-mathews-was-on-our-team-when-he-invented-the-dwf-format-our-first-foray-into-sharing-design-data-via-the.html 

·       
ADDITION 2: Although private cloud support is a ways off, we
do have (Autodesk Remote) today. You can host our applications on your
own servers today and access them via your local area network — no internet
connectivity required.
Collaboration
is alive in the lab. - Scott sheppard
And...



·       
http://forums.autodesk.com/t5/Design-Review/Is-Design-Review-discontinued/m-p/4419091 
Options
09-11-2013 01:08 PM in reply to: jeffreybm
Autodesk
Design Review 2013 will continue to be available for download from our
website, but 
Autodesk is focusing on delivering enhanced cloud and mobile
workflows
(emphasis RA/mine) that integrate with desktop collaboration.
  Enhancements to the desktop viewing experience will most likely come
from that work, and not a desktop-only solution like Design Review. The DWF
file format did not change as part of the 2014 releases, so Autodesk Design
Review 2013 works perfectly with the 2014 product line.




Scott Sheppard

Program Manager

Autodesk Labs

Autodesk, Inc.
 






The second site on AD Forums:






Re: Is Design Review discontinued?Re: Is Design Review discontinued?
09-11-2013 01:08 PM in reply to: jeffreybm
Autodesk Design Review 2013 will continue to
be available for download from our website, but Autodesk is focusing on
delivering enhanced cloud and mobile workflows that integrate with desktop
collaboration.  Enhancements to the desktop viewing experience will most
likely come from that work, and not a desktop-only solution like Design
Review. The DWF file format did not change as part of the 2014 releases, so
Autodesk Design Review 2013 works perfectly with the 2014 product line.




Scott Sheppard

Program Manager

Autodesk Labs

Autodesk, Inc.

 We are in 2015 - and about every 3 years the autodesk file format changes- so AutoDESK 2016 I suspect we will see DWG 2016 format file save option...(emphasis RA/mine) 






Then on page 4:






Re: Is Design Review discontinued?Re: Is Design Review discontinued?
09-19-2013 05:25 AM in reply to: O.Maille
Thank you for the question. I am not here to
delude anyone. If you want an electronic review process, given the current
state of Autodesk 360, Autodesk Design Review is still the way to go. But the
original question was is Design Review being discontinued, and the answer is
yes, it will eventually be replaced by Autodesk 360. Until that time, the
2013 version is available for download from the Autodesk site and works with
the 2014 product line since the DWF format did not change. 




Scott Sheppard

Program Manager

Autodesk Labs

Autodesk, Inc.






 If you want an electronic review process,
given the current state of Autodesk 360, Autodesk Design Review is still the
way to go. But the original question was is Design Review being discontinued,
and the answer is yes, it will eventually be replaced by Autodesk 360. Until
that time, the 2013 version is available for download from the Autodesk site
and works with the 2014 product line since the DWF format did not
change. 






So ADR desktop is dead... unless you want to do everything in
AutoDESK's cloud. This is controverts the objective for server to be able to
a stand-alone.






Autodesk no longer supports it... so the next file version
change that comes out expect issues. We've been on 2013 and are still on file
format version 2013 in AutoCAD 2015... but about every 3 ACAD versions the
file format updates.






: )




Monday, September 1, 2014

Convert Deltek Report (CSV, TXT) to folder structure based on indexing of NCS4.0

This code takes a CSV formatted report from Deltek and looks for key variables in the report header to create a folder structure. In lieu of long folder names it creates numbers and descriptive shortcuts to the folders. VBS Code below:

 Option Explicit
Const version = "v2014-09-03-01.0"
''Script takes a csv text based output report from Deltek and uses it to create folder structure on P.
Const strFPt = "P:\"        ''Target File PathDim FP
Const vbqt = """"               ''define VBQt for quotation mark

''Lots of globals on this one:
Public strDataArr               ''Readline of data from file
Public strDiscID                ''discipline ID
Const RemapE = True         ''Remap E will create the S/SZ folders if E is in the disciplines .
Const ForReading = 1, ForWriting = 2, ForAppending = 8  ''
   
  '''Deltek Variables stores index of variables based on
Dim kCliBillName                '', "Billing Client Name", -1
Dim kCliContact             '', "Billing Contact Name", -1
Dim kCliAddress             '', "Client Address", -1
Dim kCliName                    '', "Client Name", -1
Dim kCliNameContact         '', "Contact Name", -1
Dim kLocale                     '', "Locale", -1
Dim kProjNamelong               '', "LongName", -1
Dim kProjNameshort          '', "Name", -1
Dim kOwnerName                  '', "Owner Name", -1
Dim kOwnerNumber                '', "Owner Number", -1
Dim kProj                       '', "Project", -1
Dim kProd                       '', "Product/Phase", -1
Dim kdisc                       '', "Discipline", -1
''FILE MANIPULATION OBJECTS AND REFERENCES''''''''''''''''''
Dim fso                         ''As New FileSystemObject for creating folders
Dim objWSH                      ''As New WshShell for creating shortcuts
Dim KeySet                      ''Bool check if key was set
Dim strKeyUB                    ''Max ubound of key
Dim strDataUB                   ''ub of data array
Dim StrMsg                      ''for building up message
Dim intFolderCt                 ''Count of folders added
Dim intFolderRef                ''Folders referenced
Dim MyFile                      ''MyFile for opening target file, Textline for holding one line at a time
Dim Textline                    ''MyFile for opening target file, Textline for holding one line at a time
Dim DirLevels                   ''Limiting dir levels if 0 ir unspecified limits to 2, if -1 create all subfolders for disciplines
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''END VARIABLES'''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Main                                ''Execute MAIN routine
'Dim wscript As New objWSCRIPT_Emulator    ''FOR DEBUGGING IN EXCEL WITH WSCRIPT CLASSES
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''MAIN ROUTINE''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Main()
   
    Dim FileName, I, temp           ''input file name
    DirLevels = -99                 ''init as -99
   
    Call Initilize(True)            ''INITIALIZE VARIABLES (IN ANTICIPATION OF CONVERSAION OF THIS PARAMETER TO A CLASS)

    ''Sort WSCRIPT ARGS''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    For I = 0 To wscript.Arguments.count - 1
        If FileName = "" Then
            FileName = ReturnMatch(wscript.Arguments(I), "([a-z]:\\(?:[-\w\s\.\d]+\\)*(?:[-\w\s\.\d]+)?)")
        End If
        If DirLevels = -99 Then
            temp = ReturnMatch(wscript.Arguments(I), "\/limit:([-+]{0,1}\d+)")    ''look for string from submatch
            If temp > "" Then
                        DirLevels = Cint(temp)
                  END IF
        End If
    Next 'i

      if dirlevels =-99 and FileName > "" then
            temp=Cint(inputbox("Number of sub folders under client?" & VBCR & VBCR &_
                             "(P:\0.client\1.Region\(2.Product)\3.Disciplines\)" & VBCR  & VBCR & _
                                       "(-1 to create ALL 19+ Disciplines)","Specify allowable depth of sub-folders",2))
            if temp < -1 or temp > 3 then
                  DirLevels  = 3
            else
                  dirlevels = temp
            end if
      end if
     
    If DirLevels = -99 Then DirLevels = 2

    If FileName = "" Then
        StrMsg = "Please create a report in deltek and save it as a CSV/TXT," & vbCr & _
                 "then drag and drop the report onto the script." & vbCr & _
                 "Or link the script to your SendTo folder " & vbCr & _
                 "and use sendto to send the report." & vbCr & vbCr & _
                 "-----SYNTAX-----------------------------------------------------------------" & vbCr & _
                 wscript.ScriptName & " [filepath] [/limit:nn]" & vbCr & _
                 "-----SWITCHES---------------------------------------------------------------" & vbCr & _
                 "Specify /LIMIT:[folder limit] for allowed subdirs below client(Default 2)" & vbCr & _
                 "   -1  = create all disciplines" & vbCr & _
                 "    0  = Create client\ only " & vbCr & _
                 "    1  = Create client\region only " & vbCr & _
                 "    2  = Create client\region\product only " & vbCr & _
                 "[n...] = Limit to N number of sub-folders deep:" & vbCr & _
                 "       P:\0.client\1.Region\2.Product\3.Disciplines (specified by report)"
        Terminate (vbOKOnly & vbCritical)
        Exit Sub
    ElseIf Not fso.FileExists(FileName) Then
        StrMsg = "ERROR, Cannot find file " & FileName
        Terminate (vbOKOnly & vbCritical)
    End If
    On Error GoTo 0
   
    ' Open the file for input.
    Set MyFile = fso.OpenTextFile(FileName, ForReading)
   
    ' Read from the file and display the results.
    Do While MyFile.AtEndOfStream <> True           '''while not eof
        Textline = MyFile.ReadLine                  ''Get next line of data
        Textline = Reformat(Textline)               ''reformats csv to tab delimited and gets rid of quotes
       
        If Textline > "" Then                       '' if not null
            If ReturnMatch(Textline, "detail_*") > "" Then    ''if matches detail
                SetKeyInit (Textline)
            Else
                If KeySet Then
                    SetData (Textline)              ''Set data array
                    CreateFolders strDataArr, fso
                End If
            End If
        End If
    Loop
   
    Terminate (vbOKOnly)
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''Initialize variables and file manipulation objects'''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Initilize(noargs)
    Set fso = CreateObject("Scripting.FileSystemObject")            ''File System Object for creating folders
    Set objWSH = CreateObject("WScript.Shell")                      ''Wscript shell for creating shortcuts
   
    Dim q
    q = Array( _
            Array("00-00-C-", "00-00-C-Non-trades Client folder", "Non-trades Client folder(If not one of the other categories listed below)"), _
            Array("01-00-G-", "01-00-G-General-Index", "G General All or any portion of subjects included in Level 2"), _
            Array("05-00-C-", "05-00-C-Civil", "C Civil All or any portion of subjects included in Level 2"), _
            Array("06-00-L-", "06-00-L-Landscape", "L Landscape All or any portion of subjects included in Level 2"), _
            Array("07-00-S-", "07-00-S--Structural", "S Structural All or any portion of subjects included in Level 2"), _
            Array("07-00-SZ", "07-00-SZ-Structural PM folder", "SZ Structural PROJECT MANAGERS FOLDER"), _
            Array("08-00-A-", "08-00-A-Architectural", "A Architectural All or any portion of subjects included in Level 2"), _
            Array("08-00-AZ", "08-00-AZ-Architectural PM FOLDER", "AZ Architectural PROJECT MANAGER FOLDER"), _
            Array("09-00-I-", "09-00-I-Interiors", "I Interiors All or any portion of subjects included in Level 2"), _
            Array("09-00-IZ", "09-00-IZ-Interiors PM FOLDER", "IZ Interiors PROJECT MANAGER FOLDER"), _
            Array("10-00-Q-", "10-00-Q-Equipment", "Q Equipment All or any portion of subjects included in Level 2"), _
            Array("11-00-F-", "11-00-F-Fire Protection", "F Fire Protection All or any portion of subjects included in Level 2"), _
            Array("12-00-P-", "12-00-P-Plumbing", "P Plumbing All or any portion of subjects included in Level 2"), _
            Array("14-00-M-", "14-00-M-Mechanical", "M Mechanical All or any portion of subjects included in Level 2"), _
            Array("15-00-E-", "15-00-E-Electrical", "E Electrical All or any portion of subjects included in Level 2"), _
            Array("16-00-T-", "16-00-T-Telecommunications", "T Telecommunications All or any portion of subjects included in Level 2"), _
            Array("17-00-R-", "17-00-R-Resource Data", "R Resource Data furnished without warrant as to accuracy (e.g. typical or previous drawings used for reference)"), _
            Array("18-00-X-", "18-00-X-Other Disciplines", "X Other Disciplines All or any portion of subjects included in Level 2"), _
            Array("19-00-Z-", "19-00-Z-Contractor-Shop Drawings", "Z Contractor /Shop Drawings All or any portion of subjects included in Level 2"), _
            Array("90-00---", "90-00---Inter-discipline meetings", "This category only used for inter-discipline meetings, i.e. team kickoff.") _
            )
    Dim ct
   
    ct = UBound(q, 1)
    ReDim strDiscID(ct + 1, 3)
    Dim I
    For I = 0 To ct - 1
        strDiscID(I + 1, 1) = q(I + 1)(0)
        strDiscID(I + 1, 2) = q(I + 1)(1)
        strDiscID(I + 1, 3) = q(I + 1)(2)
    Next ''I
End Sub



Function Reformat(Textline)
    ''if a line has quites, then there is a comma interfering with the string.. i.e. "lastname, firstname"
    ''looks for commas inside quotes and substitutes "_"
    Dim I
    Dim QTon ''quote on boolean
    QTon = False
    Dim aa
    Reformat = ""
    For I = 1 To Len(Textline)
        aa = Mid(Textline, I, 1)
        If aa = vbTab Then aa = "-"             ''strip out native tabs
        If aa = vbqt Then                       ''IF Quote character then
            QTon = Not (QTon)                       ''flip QTON and drop the character
        Else                                    ''else NOT a quote character
            If QTon Then                            ''Quote on = true then add the character
                Reformat = Reformat + aa
            Else                                    ''quote on = false- we are outside quotes-
                If aa = "," Then aa = vbTab         ''substitute TAB for comma
                Reformat = Reformat + aa            ''Add subbed character
            End If
        End If
    Next ''I
End Function

Sub Terminate(buttons)
    If buttons = 0 Then buttons = vbOKOnly
   
    On Error Resume Next
   
    MyFile.Close
    MsgBox "Script: " & wscript.ScriptFullName & vbCr & vbCr & _
           StrMsg & vbCr & vbCr & _
           "--Results---------------------------------" & vbCr & _
           Right("0000" & DirLevels, 2) & "   /LEVEL:(Dirlevels) Deep" & vbCr & _
           Right("0000" & intFolderCt, 2) & "   Folders  Created" & vbCr & _
           Right("0000" & intFolderRef, 2) & "   Folders reviewed" & vbCr, buttons, "Convert Deltek To Folders Version:" & version
    wscript.quit
End Sub

Sub CreateFolders(strDataArr, ObjFso)  '' As FileSystemObject)
   If UBound(strDataArr) < strDataUB Then
        StrMsg = StrMsg & vbCr & "Null Array Error in Create folder at folder count: " & intFolderRef & vbCr & "Str DATA LINE:" & vbCr & Textline & vbCr
        Terminate (True)
    End If
    Dim ClientBill: ClientBill = strDataArr(kCliBillName)
    Dim ClientBillCon: ClientBillCon = strDataArr(kCliContact)
    Dim ClientName: ClientName = strDataArr(kCliName)
    Dim Contact: Contact = strDataArr(kCliNameContact)
    ''Const kLocale = "detail_Locale"
    Dim Projame: Projame = strDataArr(kProjNamelong)
    Projame = Projame & strDataArr(kProjNameshort)                       ''prefix short name onto long name was mix of both in list
    Dim Owner: Owner = strDataArr(kOwnerName)
    Dim OwnerNumb: OwnerNumb = strDataArr(kOwnerNumber)
    ''Project Number
    Dim Pnum: Pnum = strDataArr(kProj)
    Dim PYear: PYear = Mid(Pnum, 1, 2)
    Dim PCliNo: PCliNo = Mid(Pnum, 3, 3)
    Dim PCliRe: PCliRe = Mid(Pnum, 6, 2)
    Dim PCProd: PCProd = Mid(Pnum, 9, 3)
    Dim Prod: Prod = strDataArr(kProd)
    Dim Disc: Disc = strDataArr(kdisc)

    ''If PCliNo > "002" Then Stop
   
    Dim FP: FP = strFPt
    Dim objFolder                           ''As Folder
    Dim Folder                              '' As Folder
    Dim I                                   ''counter
    '''client
    
    ''base folder
    FP = FP & PCliNo
    Set Folder = FolderCheck(FP, ObjFso, StrClean(ClientName & "-" & PCliNo))
    If DirLevels = 0 Then Exit Sub ''limit folder creation at level 0 client
   
    '''region folder
    FP = FP & "\" & PCliRe
    Set Folder = FolderCheck(FP, ObjFso, StrClean(ClientName))
    If DirLevels = 1 Then Exit Sub ''limit folder creation at level 1 region
   
    '''Product
    FP = FP & "\" & "-" & PCProd
    Set Folder = FolderCheck(FP, ObjFso, StrClean("-" & Trim(PCProd) & Trim("-" & Prod)))
    If DirLevels = 2 Then Exit Sub ''limit folder creation at level 2 Product
   
    ''Consultants -- using -1 for dir levels creates all consutlants
    If DirLevels = -1 Then
        For I = 1 To UBound(strDiscID, 1)
            Set Folder = FolderCheck(FP & "\" & strDiscID(I, 1), ObjFso, StrClean(strDiscID(I, 2)))
        Next 'I
    Else    ''Pass the value to CheckDiscipline
        Call CheckDiscipline(FP, ObjFso, Disc)
    End If
   
   

End Sub

Function CheckDiscipline(FP, ObjFso, Disc)
    Dim Folder
    Dim I
    Disc = Trim(Disc)
   
    If RemapE And Disc = "E" Then Disc = "S" ''''<<<<<<<<<<<<<<<<<<<<<<<<<<<<
   
    If Disc > "" Then
        For I = 1 To UBound(strDiscID)
            If ReturnMatch(strDiscID(I, 1), ".*?" & Trim(Disc) & ".*?") > "" Then
                Set Folder = FolderCheck(FP & "\" & strDiscID(I, 1), ObjFso, StrClean(strDiscID(I, 2)))
            End If
        Next  ''I
    Else
    '''optional create all anyway
    End If
End Function

Function StrClean(StrToClean)
    StrToClean = UCase(StrToClean)
    Dim I, a
    For I = 1 To Len(StrToClean)
        a = Mid(StrToClean, I, 1)
            If a >= "A" And a <= "Z" Or a >= "0" And a <= "9" Or a = "(" Or a = ")" Then
            StrClean = StrClean & a
            ElseIf a = " " And Right(StrClean, 1) <> " " Then
                StrClean = StrClean & a
            ElseIf Right(StrClean, 1) <> "-" Then
                StrClean = Trim(StrClean & "-")
            End If
    Next ''I
    Do While Right(StrClean, 1) = "-" Or Right(StrClean, 1) = " "
        StrClean = Left(StrClean, Len(StrClean) - 1)
    Loop
End Function

Function FolderCheck(FP, ObjFso, xcutName)
    On Error Resume Next
    Set FolderCheck = ObjFso.GetFolder(FP)
    intFolderRef = intFolderRef + 1
    If FolderCheck Is Nothing Then
        Set FolderCheck = ObjFso.CreateFolder(FP)
        intFolderCt = intFolderCt + 1
    End If
    XCut FolderCheck, xcutName                      ''create xcut- if it exists it will be deleted and recreated.
End Function

Sub XCut(Folder, strXcutName)
    Dim objScut
    Dim FN
    Do While (Right(strXcutName, 1) = " " Or Right(strXcutName, 1) = "-") And Len(strXcutName) > 2
        strXcutName = Left(strXcutName, Len(strXcutName) - 1)
    Loop
    FN = Folder.ParentFolder.path + "\" + strXcutName + ".lnk"
    If fso.FileExists(FN) Then fso.DeleteFile (FN)
    Set objScut = objWSH.CreateShortcut(FN)
    objScut.WindowStyle = 4  ''7=Minimized 0=Maximized  4=Normal
    objScut.TargetPath = Folder.path
    objScut.Save
End Sub

Function ReturnMatch(strStr, strMatch)
    ''VBA include Microsoft VBSCript Regular Expressions 5_5
    Dim r 'As New RegExp       ''Regexp engine
    Dim m 'As MatchCollection  ''Return value
    Dim I, x()
    'Dim StrMatch ''as pattern match
    If InStr(1, strMatch, "(") + InStr(1, strMatch, ")") = 0 Then     ''add () for subexpression to return something...
       
        If Left(strMatch, 1) <> "(" Then strMatch = "(" & strMatch
        If Right(strMatch, 1) <> ")" Then strMatch = strMatch & ")"
    End If
   
    Set r = New RegExp
    r.Pattern = strMatch
    r.IgnoreCase = True
   
    Set m = r.Execute(strStr)
   
    ''Regexp os base-o arrays so info rturned starts at (0) not (1)
    On Error Resume Next
    If m.count = 0 Then
        ReturnMatch = ""    ''return null
        Exit Function       ''nomatch
    Else
        ReturnMatch = m(0).SubMatches(0) ''return 1st submatch
    End If
End Function

Public Sub SetData(StrRdLn)
    strDataArr = Split(StrRdLn, vbTab)
    strDataUB = UBound(strDataArr)
End Sub

Sub SetKeyInit(StrRdLn)
    Dim x
    x = Split(StrRdLn, vbTab)
    KeySet = True
   
    Dim I
   
    For I = 1 To UBound(x)
    Select Case UCase(x(I))
      Case UCase("detail_BillClientName")
        kCliBillName = I
      Case UCase("detail_billContactName")
        kCliContact = I
      Case UCase("detail_CLAddress")
        kCliAddress = I
      Case UCase("detail_ClientName")
        kCliName = I
      Case UCase("detail_ContactName")
        kCliNameContact = I
      Case UCase("detail_Locale")
        kLocale = I
      Case UCase("detail_LongName")
        kProjNamelong = I
      Case UCase("detail_Name")
        kProjNameshort = I
      Case UCase("detail_OwnerName")
        kOwnerName = I
      Case UCase("detail_OwnerNumber")
        kOwnerNumber = I
      Case UCase("detail_WBS1")
        kProj = I
      Case UCase("detail_WBS2")
        kProd = I
      Case UCase("detail_WBS3")
        kdisc = I
    End Select
    Next ''I
    strKeyUB = UBound(x)
End Sub