Dynamo DYF Excel manager (Basic)(VBA)
Read DYF Files into excel and update
- UUIDs
- Category
- Description
- Name
Base on PAth.
Macro:DYF_READ
then update
then
Macro:DYF_UPDATE
Updated to show old UUID and function for new at left automatically.
2022-10-24-Update - changes file name to match NAME converting "." to "-" n the name before comitting changes.
Attribute VB_Name = "ReadDYF"
Option Explicit
Const fp = "C:\Users\rallen\AppData\Roaming\Dynamo\Dynamo Revit\2.12\definitions\"
Const vbQt = """"
Const RQ = "\" & """"
Const rpGUI = "(.*?" & RQ & "Uuid" & RQ & ":\W" & RQ & ")([0-9a-f\-]{36})(" & RQ & ".*$)"
Const rpCAT = "(.*?" & RQ & "Category" & RQ & ":\W" & RQ & ")(.*)(" & RQ & ".*$)"
Const rpDES = "(.*?" & RQ & "Description" & RQ & ":\W" & RQ & ")(.*)(" & RQ & ".*$)"
Const rpNAM = "(.*?" & RQ & "Name" & RQ & ":\W" & RQ & ")(.*)(" & RQ & ".*$)"
Sub DYFs_READ()
Dim ct As Integer
Dim fn As String
Dim fso As New FileSystemObject
Dim oFold As Folder
Dim ofile As File
Dim tStrm As TextStream
Dim spat As String
Dim re As New RegExp
Dim x
Dim strlin As String
Dim ic As Integer
Dim REXarray()
Dim found As Integer ''eq 4 and all found
REXarray = Array(rpCAT, rpDES, rpNAM, rpGUI)
With re
.Pattern = rpGUI
.Global = True
.IgnoreCase = True
.MultiLine = False
End With
Set oFold = fso.GetFolder(fp)
ct = 1
With Sheet1
With .Cells(1, 7)
.Value = Date + Time()
.NumberFormat = """Last Updated:: "" yyyy-mm-dd hh:mm:ss a/p"
End With
.Cells(1, 1) = "UUID" ''First cell for new UUID
.Cells(1, 2) = "Category"
.Cells(1, 3) = "Description"
.Cells(1, 4) = "Name"
.Cells(1, 5) = "Path"
.Cells(1, 6) = "Old UUID"
End With
For Each ofile In oFold.Files
If fso.GetExtensionName(ofile) = "dyf" Then
ct = ct + 1
Sheet1.Cells(ct, 5) = ofile.Path
Sheet1.Cells(ct, 1).Formula2R1C1 = "=Encode5Bit2HexGUID(""RA-""&LEFT(RC[3],22))"
With ofile.OpenAsTextStream(ForReading, TristateMixed)
Do While Not .AtEndOfStream
strlin = .ReadLine()
For ic = 1 To 4
With re
.Pattern = REXarray(ic - 1) ''GUID search pattern
If .test(strlin) = True Then
Set x = .Execute(strlin)
Select Case ic:
Case 1 To 3:
Sheet1.Cells(ct, ic + 1) = x.Item(0).SubMatches(1)
found = found + 1
Case 4: ''old GUID in col 6
Sheet1.Cells(ct, 6) = x.Item(0).SubMatches(1)
found = found + 1
End Select
Exit For ''ic ''one iterm per line
End If
End With
Next ic
If found = UBound(REXarray) + 1 Then Exit Do ''
Loop
found = 0
End With
End If
Next ofile
Sheet1.Columns("A:G").EntireColumn.AutoFit ''Wide to fit columns
End Sub
Sub DYFs_UPDATE()
Dim ct As Integer
Dim fn As String
Dim fso As New FileSystemObject
Dim oFold As Folder
Dim ofile As File
Dim oofile As File
Dim tStrm As TextStream
Dim spat As String
Dim re As New RegExp
Dim x
Dim strhead As String ''Header string only from all string
Dim strAll As String
Dim ic As Integer
Dim REXarray()
Dim strNewName As String ''new file name
Dim found As Integer ''eq 4 and all found
Dim DateStart() As Date ''capture starting dates
Dim ub As Integer ''ubound counter
Dim Pass As New Collection ''Passed updates by modified
Dim Fail As New Collection ''Failed updates by modified
REXarray = Array(rpGUI, rpCAT, rpDES, rpNAM)
With re
.Pattern = rpGUI
.Global = True
.IgnoreCase = True
.MultiLine = True
End With
Set oFold = fso.GetFolder(fp)
For ct = 2 To Sheet1.Cells(1, 1).End(xlDown).Row
fn = Sheet1.Cells(ct, 5) ''Get fn from cells
If fso.FileExists(fn) Then
Set ofile = fso.GetFile(fn)
''strNewName = ofile.Name
strNewName = Sheet1.Cells(ct, 4)
strNewName = Replace(strNewName, ".", "-")
ofile.Name = strNewName & ".dyf" ''Rename file to match
Set ofile = fso.GetFile(ofile.Path) ''re-get ofile
Sheet1.Cells(ct, 5) = ofile.Path ''Update path in spreadsheet
ub = ub + 1 ''Increment ubound counter
ReDim Preserve DateStart(ub)
DateStart(ub) = ofile.DateLastModified ''set date
With ofile.OpenAsTextStream(ForReading, TristateMixed)
strAll = .ReadAll
''[Crude break for string head as JSON NAME: parameters exist thorughout
strhead = Left(strAll, InStr(1, strAll, vbQt & "ElementResolver" & vbQt) - 1)
strAll = Right(strAll, Len(strAll) - Len(strhead))
For ic = 1 To 4
With re:
.Pattern = REXarray(ic - 1) ''GUID search pattern
If .test(strhead) = True Then
Set x = .Execute(strhead)
strhead = .Replace(strhead, "$1" & Sheet1.Cells(ct, ic) & "$3")
End If
End With
Next ic
''Set ofile = Nothing
fn = Sheet1.Cells(ct, 5) ''Get updated fn from cells
fso.CreateTextFile fn, True, True
Set oofile = fso.GetFile(fn)
With oofile.OpenAsTextStream(ForWriting, TristateTrue)
.Write strhead & strAll
.Close
End With
''Exit For ''ic ''one iterm per line
End With
End If
Next ct ''next row
''''''''''''''''''
''Validate updates
For ct = 2 To Sheet1.Cells(1, 1).End(xlDown).Row
fn = Sheet1.Cells(ct, 5) ''Get fn from cells
If fso.FileExists(fn) Then
Set ofile = fso.GetFile(fn)
If DateStart(ct - 1) < ofile.DateLastModified Then
Pass.Add "PASS:: " & ofile.Name & " - " & Format(ofile.DateLastModified, "yyyy-mm-ddthhmma/p")
Else
Fail.Add "FAIL:: " & ofile.Name & " - " & Format(ofile.DateLastModified, "yyyy-mm-ddthhmma/p")
End If
End If
Next ct ''next row
MsgBox "PASS:: " & Pass.Count & vbCr & vbCr & "FAIL:: " & Fail.Count, vbOKOnly, "Updates completed."
End Sub
Function OpenTextFile$(f)
With CreateObject("ADODB.Stream")
.Charset = "us-ascii"
.Open
.LoadFromFile f
OpenTextFile = .ReadText
End With
End Function
Function OpenTextFileFSO$(f)
Dim ofile As File
Dim fso As New FileSystemObject
Set ofile = fso.GetFile(f)
With ofile.OpenAsTextStream
OpenTextFileFSO$ = .ReadAll
.Close
End With
Set ofile = Nothing
End Function
%20t133819%20Microsoft_Visual_Studio.png)
Comments
Post a Comment