Browse Source

moved files from vba repo

Toastie 1 year ago
parent
commit
93d6cd25fa
41 changed files with 1240 additions and 75 deletions
  1. 0 75
      iperf/iperf-docker.md
  2. 0 0
      linux/ca/README.md
  3. 0 0
      linux/filesystem/initrext4-resize
  4. 0 0
      linux/log-analysis/web/group-by.md
  5. 0 0
      linux/log-analysis/win-event-log/logon-logoff.md
  6. 17 0
      microsoft_office/access/CreateView.vba
  7. 32 0
      microsoft_office/access/Import-multivalued-data-into-SharePoint.md
  8. 80 0
      microsoft_office/access/PopulateMultiValue.vba
  9. 4 0
      microsoft_office/excel/functions/Cell_ExtraHeight.vba
  10. 23 0
      microsoft_office/excel/functions/ConcatenateRange.vba
  11. 43 0
      microsoft_office/excel/functions/CopyWorksheet.vba
  12. 418 0
      microsoft_office/excel/functions/FuzzyMatch.vba
  13. 69 0
      microsoft_office/excel/functions/LookupConcat.vba
  14. 15 0
      microsoft_office/excel/functions/StripAccent.vba
  15. 26 0
      microsoft_office/excel/functions/vreplace.vba
  16. 21 0
      microsoft_office/excel/macros/Color_String_in_Cell.vba
  17. 7 0
      microsoft_office/excel/macros/EnterAndPressEnter.vba
  18. 81 0
      microsoft_office/excel/macros/FormatHelper.vba
  19. 32 0
      microsoft_office/excel/macros/GetPassword.vba
  20. 116 0
      microsoft_office/excel/macros/MatrixToList.vba
  21. 11 0
      microsoft_office/excel/macros/Personal_Macro_Workbook_to_Clipboard.vba
  22. 14 0
      microsoft_office/excel/macros/SpitWorkSheetsInFiles.vba
  23. 45 0
      microsoft_office/excel/macros/combine_sheets.vba
  24. 0 0
      microsoft_office/office_365/custom-theme.md
  25. 3 0
      python/contactsync/.gitignore
  26. 21 0
      python/contactsync/INSTALL.Dependencies.Windows.md
  27. 35 0
      python/contactsync/README.md
  28. 21 0
      python/contactsync/config-windows.txt
  29. 17 0
      python/contactsync/excel.vba
  30. 42 0
      python/contactsync/parse-vcf.py
  31. 3 0
      python/contactsync/powerquery.md
  32. 2 0
      python/contactsync/run.bat
  33. 1 0
      python/contactsync/tests/linux-testbed/carddav.url
  34. 21 0
      python/contactsync/tests/linux-testbed/config
  35. 1 0
      python/contactsync/tests/linux-testbed/password
  36. 4 0
      python/contactsync/tests/linux-testbed/run.sh
  37. 4 0
      python/contactsync/tests/linux-testbed/start-docker-container.sh
  38. 1 0
      python/contactsync/tests/linux-testbed/username
  39. 5 0
      python/contactsync/tests/linux-testbed/vdirsyncer.sh
  40. 2 0
      python/contactsync/tests/test.bat
  41. 3 0
      python/contactsync/vdirsyncer.bat

+ 0 - 75
iperf/iperf-docker.md

@@ -1,75 +0,0 @@
-```
-# Create bridge directly connected to an interface
-# https://docs.docker.com/network/macvlan/#bridge-mode
-# # Docker requires to run its own DHCP,
-# apparently it is not possible to use an existing DHCP server
-# To find a proper subnet: http://www.davidc.net/sites/default/subnets/subnets.html
-# E.g. 
-# - The existing DHCP server serves 192.168.178.0/24
-#   for the range starting 192.167.167.50 41-46
-
-docker network create -d macvlan -o parent=br0 \
-  --subnet 192.168.178.0/24 \
-  --gateway 192.168.178.1 \
-  --ip-range 192.168.178.40/29 \
-  macvlan
-docker network ls
-
-# IPERF 3
-docker run --rm -d \
-  --network macvlan \
-  --name iperf3-server \
-  --ip 192.168.178.40 \
-  alpine \
-  sh -c \
-     "
-     apk add iperf3 \
-     && ip addr show dev eth0 \
-     && iperf3 -s \
-     "
-
-# IPERF 2
-docker run --rm -d \
-  --network macvlan \
-  --name iperf2-server \
-  --ip 192.168.178.42 \
-  alpine \
-  sh -c \
-     "
-     apk add iperf \
-     && ip addr show dev eth0 \
-     && iperf -s \
-     "
-
-# CLIENT IPERF3
-docker run --rm \
-  --network macvlan \
-  --name iperf3-client \
-  --ip 192.168.178.41 \
-  alpine \
-  sh -c \
-     "
-     apk add iperf3 \
-     && ip addr show dev eth0 \
-     && iperf3 -c 192.168.178.40
-     "
-
-# CLIENT IPERF2
-docker run --rm \
-  --network macvlan \
-  --name iperf3-client \
-  --ip 192.168.178.41 \
-  alpine \
-  sh -c \
-     "
-     apk add iperf \
-     && ip addr show dev eth0 \
-     && iperf -c 192.168.178.42
-     "
-
-
-# Cleanup
-docker kill iperf2-server
-docker kill iperf3-server
-docker network rm macvlan
-```

ca/README.md → linux/ca/README.md


filesystem/initrext4-resize → linux/filesystem/initrext4-resize


log-analysis/web/group-by.md → linux/log-analysis/web/group-by.md


log-analysis/win-event-log/logon-logoff.md → linux/log-analysis/win-event-log/logon-logoff.md


+ 17 - 0
microsoft_office/access/CreateView.vba

@@ -0,0 +1,17 @@
+'https://stackoverflow.com/questions/32770318/attempting-create-view-in-access-gives-syntax-error-in-create-table-statement
+
+Public Function CreateView()
+
+Dim strSql As String
+
+strSql = "CREATE VIEW temp_view AS" & vbCrLf & _
+"SELECT" & vbCrLf & _
+"   inventory2.[Unique ID] AS unique_id ," & vbCrLf & _
+"   inventory2.[Used in Site] AS mv ," & vbCrLf & _
+"   ExtraLoad.[Used in Site] AS csv" & vbCrLf & _
+"FROM inventory2 , ExtraLoad" & vbCrLf & _
+"WHERE inventory2.[Unique ID] =  ExtraLoad.[Unique ID];"
+
+CurrentProject.Connection.Execute strSql
+
+End Function

+ 32 - 0
microsoft_office/access/Import-multivalued-data-into-SharePoint.md

@@ -0,0 +1,32 @@
+### Load multivalued data into a SharePoint list
+
+#### Problem Statement
+
+We have 
+* A SharePoint list with a multivalued lookup list referring to another table
+* An Excel sheet with comma-seperated mutlivalued data
+
+We want
+* Import the Excel sheet into SharePoint via Access
+
+Issue
+* Access is not capable to translate the multivalued fields during the import :-(
+
+
+#### Steps to Workaround
+
+1. Prepare your data in Excel for import
+    1. Split your data into two tables, one with and another without the multivalued field.
+       Both tables have to be equipped with a unique ID to match them together in a later step.
+    1. Load the table with the lookup references into Excel
+    1. In the table with the multivalued fields, translate the bound display values in bound values using [vreplace](../function/vreplace.vba)-function
+   
+1. Open the SharePoint list as linked table in Access
+    1. Import the data from Excel, without multivalued fields into the SharePoint list
+    2. Import the data with the multivalued data into a temporary table
+    3. Run the [macro](populate-multivalued.vba) to populate the multivalued fields
+    
+
+#### Reference
+* [Query MVFs](https://support.office.com/en-us/article/using-multivalued-fields-in-queries-6f64f92d-659f-411c-9503-b6624e1e323a)
+* [Macro to translate CSV to MVF](https://social.msdn.microsoft.com/Forums/office/en-US/384f46cd-2a67-4efa-883e-83004700e144/how-to-import-into-a-table-with-multivalue-fields?forum=accessdev)

+ 80 - 0
microsoft_office/access/PopulateMultiValue.vba

@@ -0,0 +1,80 @@
+Sub PopulateMultiValue()
+
+    Dim db As DAO.Database
+    Dim srcTbl As String: srcTbl = "ExtraLoad"  ' Source table name
+    Dim srcRS As DAO.Recordset2
+    Dim srcQry As String
+    Dim srcQdf As DAO.QueryDef
+    Dim csv() As String
+    Dim csvString As String
+    Dim csvSize As Integer
+    
+    Dim tgtTbl As String: tgtTbl = "inventory2" ' Target table name
+    Dim tgtRS As DAO.Recordset2
+    
+    Dim idFld As String: idFld = "[Unique ID]"  ' Field to join the src with tgt table
+    Dim ID As String
+    Dim flds() As String: flds = Split("[Used in Site],[Supplier Name],[Integrator Name],[Hosting Partner Name]", ",")
+    'Dim flds() As String: flds = Split("[Used in Site]", ",")
+    Dim fld As Variant
+         
+    Dim mvfld As DAO.Field2                     ' Multi-value record set
+    Dim mvrs As DAO.Recordset2                  ' Multi-value field
+    
+    ' Open source and target
+    
+    Debug.Print "Start "; Format(Now(), "yyyy-MM-dd hh:mm:ss")
+    Set db = CurrentDb()
+    Set srcRS = db.OpenRecordset(srcTbl)
+    Set tgtRS = db.OpenRecordset(tgtTbl)
+       
+    For Each fld In flds
+        
+        Debug.Print "**********Begin with field: "; fld
+        Set mvfld = tgtRS(fld)
+       
+            ' Loop through target table
+            tgtRS.MoveFirst
+            Do Until tgtRS.EOF
+            
+               Debug.Print "tgt unique id: "; tgtRS(idFld)
+               Set mvrs = mvfld.Value
+               tgtRS.Edit
+               
+               ID = tgtRS(idFld) ' Current ID in the target
+               ' Create source record set using temporary query defintion (name = "")
+               srcQry = "SELECT " & srcTbl & "." & fld & " FROM " & srcTbl & " LEFT JOIN " & tgtTbl & " ON " & srcTbl & "." & idFld & "=" & tgtTbl & "." & idFld & " WHERE " & srcTbl & "." & idFld & " = '" & ID & "';"
+               Set srcQdf = db.CreateQueryDef("", srcQry)
+               Set srcRS = srcQdf.OpenRecordset
+               
+               If srcRS.EOF Then
+                  Debug.Print " > no value in source"
+                        
+               Else
+                  Debug.Print " > src value:"; srcRS(fld).Value
+                  If srcRS(fld).Value <> "" Then
+                     'Parse csv into array
+                     csv = Split(srcRS(fld).Value, ",")
+                     'Add values from source one by one
+                     For Each v In csv
+                           Debug.Print "  > Adding: "; v
+                           mvrs.AddNew
+                           mvrs("Value") = v
+                           mvrs.Update
+                     Next
+                  End If
+               End If
+                    
+               mvrs.Close
+               tgtRS.Update
+               
+            tgtRS.MoveNext
+            Loop
+    Next
+    
+    ' Cleanup
+    srcRS.Close
+    tgtRS.Close
+    db.Close
+    Debug.Print "done"
+End Sub

+ 4 - 0
microsoft_office/excel/functions/Cell_ExtraHeight.vba

@@ -0,0 +1,4 @@
+Sub ExtraHeight()
+ActiveCell.EntireRow.AutoFit
+ActiveCell.RowHeight = ActiveCell.RowHeight + 10
+End Sub

+ 23 - 0
microsoft_office/excel/functions/ConcatenateRange.vba

@@ -0,0 +1,23 @@
+Function ConcatenateRange(ByVal cell_range As Range, _
+                    Optional ByVal seperator As String) As String
+
+Dim cell As Range
+Dim newString As String
+Dim cellArray As Variant
+Dim i As Long, j As Long
+
+cellArray = cell_range.value
+
+For i = 1 To UBound(cellArray, 1)
+    For j = 1 To UBound(cellArray, 2)
+        If Len(cellArray(i, j)) <> 0 Then
+            newString = newString & (seperator & cellArray(i, j))
+        End If
+    Next
+Next
+
+If Len(newString) <> 0 Then
+    newString = Right$(newString, (Len(newString) - Len(seperator)))
+End If
+
+ConcatenateRange = newString

+ 43 - 0
microsoft_office/excel/functions/CopyWorksheet.vba

@@ -0,0 +1,43 @@
+   Sub BlattKopieren()
+      Dim NeuerName As String
+      Dim i As Integer
+      Do While NeuerName = ""
+      NeuerName = InputBox("Please enter a new worksheet name!")
+      Loop
+      i = Sheets.Count
+      Sheets("Vorlage").Copy After:=Sheets(i)
+      ActiveSheet.Cells(6, 2) = NeuerName
+      ActiveSheet.Name = CleanWorksheetName(NeuerName)
+   End Sub
+
+Function CleanWorksheetName(ByRef strName As String) As String
+    Dim varBadChars As Variant
+    Dim varChar As Variant
+     
+    varBadChars = Array(":", "/", "\", "?", "*", "[", "]")
+     
+     'correct string for forbidden characters
+    For Each varChar In varBadChars
+        Select Case varChar
+        Case ":"
+            strName = Replace(strName, varChar, vbNullString)
+        Case "/"
+            strName = Replace(strName, varChar, "-")
+        Case "\"
+            strName = Replace(strName, varChar, "-")
+        Case "?"
+            strName = Replace(strName, varChar, vbNullString)
+        Case "*"
+            strName = Replace(strName, varChar, vbNullString)
+        Case "["
+            strName = Replace(strName, varChar, "(")
+        Case "]"
+            strName = Replace(strName, varChar, ")")
+        End Select
+    Next varChar
+     
+     'correct string for worksheet length requirement
+    strName = Left(strName, 31)
+     
+    CleanWorksheetName = strName
+End Function

+ 418 - 0
microsoft_office/excel/functions/FuzzyMatch.vba

@@ -0,0 +1,418 @@
+Option Explicit
+Type RankInfo
+    Offset As Integer
+    Percentage As Single
+End Type
+
+Function FuzzyPercent(ByVal String1 As String, _
+                      ByVal String2 As String, _
+                      Optional Algorithm As Integer = 3, _
+                      Optional Normalised As Boolean = False) As Single
+'*************************************
+'** Return a % match on two strings **
+'*************************************
+Dim intLen1 As Integer, intLen2 As Integer
+Dim intCurLen As Integer
+Dim intTo As Integer
+Dim intPos As Integer
+Dim intPtr As Integer
+Dim intScore As Integer
+Dim intTotScore As Integer
+Dim intStartPos As Integer
+Dim strWork As String
+
+'-------------------------------------------------------
+'-- If strings havent been normalised, normalise them --
+'-------------------------------------------------------
+If Normalised = False Then
+    String1 = LCase$(Application.Trim(String1))
+    String2 = LCase$(Application.Trim(String2))
+End If
+
+'----------------------------------------------
+'-- Give 100% match if strings exactly equal --
+'----------------------------------------------
+If String1 = String2 Then
+    FuzzyPercent = 1
+    Exit Function
+End If
+
+intLen1 = Len(String1)
+intLen2 = Len(String2)
+
+'----------------------------------------
+'-- Give 0% match if string length < 2 --
+'----------------------------------------
+If intLen1 < 2 Then
+    FuzzyPercent = 0
+    Exit Function
+End If
+
+intTotScore = 0                   'initialise total possible score
+intScore = 0                      'initialise current score
+'Taken from: http://www.mrexcel.com/forum/excel-questions/195635-fuzzy-matching-new-version-plus-explanation.html
+
+'--------------------------------------------------------
+'-- If Algorithm = 1 or 3, Search for single characters --
+'--------------------------------------------------------
+If (Algorithm And 1) <> 0 Then
+    FuzzyAlg1 String1, String2, intScore, intTotScore
+    If intLen1 < intLen2 Then FuzzyAlg1 String2, String1, intScore, intTotScore
+End If
+
+'-----------------------------------------------------------
+'-- If Algorithm = 2 or 3, Search for pairs, triplets etc. --
+'-----------------------------------------------------------
+If (Algorithm And 2) <> 0 Then
+    FuzzyAlg2 String1, String2, intScore, intTotScore
+    If intLen1 < intLen2 Then FuzzyAlg2 String2, String1, intScore, intTotScore
+End If
+
+FuzzyPercent = intScore / intTotScore
+
+End Function
+Private Sub FuzzyAlg1(ByVal String1 As String, _
+                      ByVal String2 As String, _
+                      ByRef Score As Integer, _
+                      ByRef TotScore As Integer)
+Dim intLen1 As Integer, intPos As Integer, intPtr As Integer, intStartPos As Integer
+
+intLen1 = Len(String1)
+TotScore = TotScore + intLen1              'update total possible score
+intPos = 0
+For intPtr = 1 To intLen1
+    intStartPos = intPos + 1
+    intPos = InStr(intStartPos, String2, Mid$(String1, intPtr, 1))
+    If intPos > 0 Then
+        If intPos > intStartPos + 3 Then     'No match if char is > 3 bytes away
+            intPos = intStartPos
+        Else
+            Score = Score + 1          'Update current score
+        End If
+    Else
+        intPos = intStartPos
+    End If
+Next intPtr
+End Sub
+Private Sub FuzzyAlg2(ByVal String1 As String, _
+                        ByVal String2 As String, _
+                        ByRef Score As Integer, _
+                        ByRef TotScore As Integer)
+Dim intCurLen As Integer, intLen1 As Integer, intTo As Integer, intPtr As Integer, intPos As Integer
+Dim strWork As String
+
+intLen1 = Len(String1)
+For intCurLen = 2 To intLen1
+    strWork = String2                          'Get a copy of String2
+    intTo = intLen1 - intCurLen + 1
+    TotScore = TotScore + Int(intLen1 / intCurLen)  'Update total possible score
+    For intPtr = 1 To intTo Step intCurLen
+        intPos = InStr(strWork, Mid$(String1, intPtr, intCurLen))
+        If intPos > 0 Then
+            Mid$(strWork, intPos, intCurLen) = String$(intCurLen, &H0) 'corrupt found string
+            Score = Score + 1     'Update current score
+        End If
+    Next intPtr
+Next intCurLen
+
+End Sub
+
+Function FuzzyVLookup(ByVal LookupValue As String, _
+                      ByVal TableArray As Range, _
+                      ByVal IndexNum As Integer, _
+                      Optional NFPercent As Single = 0.05, _
+                      Optional Rank As Integer = 1, _
+                      Optional Algorithm As Integer = 3, _
+                      Optional AdditionalCols As Integer = 0) As Variant
+'********************************************************************************
+'** Function to Fuzzy match LookupValue with entries in                        **
+'** column 1 of table specified by TableArray.                                 **
+'** TableArray must specify the top left cell of the range to be searched      **
+'** The function stops scanning the table when an empty cell in column 1       **
+'** is found.                                                                  **
+'** For each entry in column 1 of the table, FuzzyPercent is called to match   **
+'** LookupValue with the Table entry.                                          **
+'** 'Rank' is an optional parameter which may take any value > 0               **
+'**        (default 1) and causes the function to return the 'nth' best        **
+'**         match (where 'n' is defined by 'Rank' parameter)                   **
+'** If the 'Rank' match percentage < NFPercent (Default 5%), #N/A is returned. **
+'** IndexNum is the column number of the entry in TableArray required to be    **
+'** returned, as follows:                                                      **
+'** If IndexNum > 0 and the 'Rank' percentage match is >= NFPercent            **
+'**                 (Default 5%) the column entry indicated by IndexNum is     **
+'**                 returned.                                                  **
+'** if IndexNum = 0 and the 'Rank' percentage match is >= NFPercent            **
+'**                 (Default 5%) the offset row (starting at 1) is returned.   **
+'**                 This value can be used directly in the 'Index' function.   **
+'**                                                                            **
+'** Algorithm can take one of the following values:                            **
+'** Algorithm = 1:                                                             **
+'**     This algorithm is best suited for matching mis-spellings.              **
+'**     For each character in 'String1', a search is performed on 'String2'.   **
+'**     The search is deemed successful if a character is found in 'String2'   **
+'**     within 3 characters of the current position.                           **
+'**     A score is kept of matching characters which is returned as a          **
+'**     percentage of the total possible score.                                **
+'** Algorithm = 2:                                                             **
+'**     This algorithm is best suited for matching sentences, or               **
+'**     'firstname lastname' compared with 'lastname firstname' combinations   **
+'**     A count of matching pairs, triplets, quadruplets etc. in 'String1' and **
+'**     'String2' is returned as a percentage of the total possible.           **
+'** Algorithm = 3: Both Algorithms 1 and 2 are performed.                      **
+'********************************************************************************
+Dim r As Range
+
+Dim strListString As String
+Dim strWork As String
+
+Dim sngMinPercent As Single
+Dim sngWork As Single
+Dim sngCurPercent  As Single
+Dim intBestMatchPtr As Integer
+Dim intRankPtr As Integer
+Dim intRankPtr1 As Integer
+Dim i As Integer
+
+Dim lEndRow As Long
+
+Dim udRankData() As RankInfo
+
+Dim vCurValue As Variant
+
+'--------------------------------------------------------------
+'--    Validation                                            --
+'--------------------------------------------------------------
+
+LookupValue = LCase$(Application.Trim(LookupValue))
+
+If IsMissing(NFPercent) Then
+    sngMinPercent = 0.05
+Else
+    If (NFPercent <= 0) Or (NFPercent > 1) Then
+        FuzzyVLookup = "*** 'NFPercent' must be a percentage > zero ***"
+        Exit Function
+    End If
+    sngMinPercent = NFPercent
+End If
+
+If Rank < 1 Then
+    FuzzyVLookup = "*** 'Rank' must be an integer > 0 ***"
+    Exit Function
+End If
+
+ReDim udRankData(1 To Rank)
+
+lEndRow = TableArray.Rows.Count
+If VarType(TableArray.Cells(lEndRow, 1).value) = vbEmpty Then
+    lEndRow = TableArray.Cells(lEndRow, 1).End(xlUp).Row
+End If
+
+'---------------
+'-- Main loop --
+'---------------
+For Each r In Range(TableArray.Cells(1, 1), TableArray.Cells(lEndRow, 1))
+    vCurValue = ""
+    For i = 0 To AdditionalCols
+        vCurValue = vCurValue & r.Offset(0, i).Text
+    Next i
+    If VarType(vCurValue) = vbString Then
+        strListString = LCase$(Application.Trim(vCurValue))
+        
+        '------------------------------------------------
+        '-- Fuzzy match strings & get percentage match --
+        '------------------------------------------------
+        sngCurPercent = FuzzyPercent(String1:=LookupValue, _
+                                     String2:=strListString, _
+                                     Algorithm:=Algorithm, _
+                                     Normalised:=True)
+        
+        If sngCurPercent >= sngMinPercent Then
+            '---------------------------
+            '-- Store in ranked array --
+            '---------------------------
+            For intRankPtr = 1 To Rank
+                If sngCurPercent > udRankData(intRankPtr).Percentage Then
+                    For intRankPtr1 = Rank To intRankPtr + 1 Step -1
+                        With udRankData(intRankPtr1)
+                            .Offset = udRankData(intRankPtr1 - 1).Offset
+                            .Percentage = udRankData(intRankPtr1 - 1).Percentage
+                        End With
+                    Next intRankPtr1
+                    With udRankData(intRankPtr)
+                        .Offset = r.Row
+                        .Percentage = sngCurPercent
+                    End With
+                    Exit For
+                End If
+            Next intRankPtr
+        End If
+        
+    End If
+Next r
+
+If udRankData(Rank).Percentage < sngMinPercent Then
+    '--------------------------------------
+    '-- Return '#N/A' if below NFPercent --
+    '--------------------------------------
+    FuzzyVLookup = CVErr(xlErrNA)
+Else
+    intBestMatchPtr = udRankData(Rank).Offset - TableArray.Cells(1, 1).Row + 1
+    If IndexNum > 0 Then
+        '-----------------------------------
+        '-- Return column entry specified --
+        '-----------------------------------
+        FuzzyVLookup = TableArray.Cells(intBestMatchPtr, IndexNum)
+    Else
+        '-----------------------
+        '-- Return offset row --
+        '-----------------------
+        FuzzyVLookup = intBestMatchPtr
+    End If
+End If
+End Function
+Function FuzzyHLookup(ByVal LookupValue As String, _
+                      ByVal TableArray As Range, _
+                      ByVal IndexNum As Integer, _
+                      Optional NFPercent As Single = 0.05, _
+                      Optional Rank As Integer = 1, _
+                      Optional Algorithm As Integer = 3) As Variant
+'********************************************************************************
+'** Function to Fuzzy match LookupValue with entries in                        **
+'** row 1 of table specified by TableArray.                                    **
+'** TableArray must specify the top left cell of the range to be searched      **
+'** The function stops scanning the table when an empty cell in row 1          **
+'** is found.                                                                  **
+'** For each entry in row 1 of the table, FuzzyPercent is called to match      **
+'** LookupValue with the Table entry.                                          **
+'** 'Rank' is an optional parameter which may take any value > 0               **
+'**        (default 1) and causes the function to return the 'nth' best        **
+'**         match (where 'n' is defined by 'Rank' parameter)                   **
+'** If the 'Rank' match percentage < NFPercent (Default 5%), #N/A is returned. **
+'** IndexNum is the row number of the entry in TableArray required to be       **
+'** returned, as follows:                                                      **
+'** If IndexNum > 0 and the 'Rank' percentage match is >= NFPercent            **
+'**                 (Default 5%) the row entry indicated by IndexNum is        **
+'**                 returned.                                                  **
+'** if IndexNum = 0 and the 'Rank' percentage match is >= NFPercent            **
+'**                 (Default 5%) the offset col (starting at 0) is returned.   **
+'**                 This value can be used directly in the 'OffSet' function.  **
+'**                                                                            **
+'** Algorithm can take one of the following values:                            **
+'** Algorithm = 1:                                                             **
+'**     For each character in 'String1', a search is performed on 'String2'.   **
+'**     The search is deemed successful if a character is found in 'String2'   **
+'**     within 3 characters of the current position.                           **
+'**     A score is kept of matching characters which is returned as a          **
+'**     percentage of the total possible score.                                **
+'** Algorithm = 2:                                                             **
+'**     A count of matching pairs, triplets, quadruplets etc. in 'String1' and **
+'**     'String2' is returned as a percentage of the total possible.           **
+'** Algorithm = 3: Both Algorithms 1 and 2 are performed.                      **
+'********************************************************************************
+Dim r As Range
+
+Dim strListString As String
+Dim strWork As String
+
+Dim sngMinPercent As Single
+Dim sngWork As Single
+Dim sngCurPercent  As Single
+
+Dim intBestMatchPtr As Integer
+Dim intPtr As Integer
+Dim intRankPtr As Integer
+Dim intRankPtr1 As Integer
+
+Dim iEndCol As Integer
+
+Dim udRankData() As RankInfo
+
+Dim vCurValue As Variant
+'--------------------------------------------------------------
+'--    Validation                                            --
+'--------------------------------------------------------------
+LookupValue = LCase$(Application.Trim(LookupValue))
+
+If IsMissing(NFPercent) Then
+    sngMinPercent = 0.05
+Else
+    If (NFPercent <= 0) Or (NFPercent > 1) Then
+        FuzzyHLookup = "*** 'NFPercent' must be a percentage > zero ***"
+        Exit Function
+    End If
+    sngMinPercent = NFPercent
+End If
+
+If Rank < 1 Then
+    FuzzyHLookup = "*** 'Rank' must be an integer > 0 ***"
+    Exit Function
+End If
+
+ReDim udRankData(1 To Rank)
+'**************************
+iEndCol = TableArray.Columns.Count
+If VarType(TableArray.Cells(1, iEndCol).value) = vbEmpty Then
+    iEndCol = TableArray.Cells(1, iEndCol).End(xlToLeft).Column
+End If
+
+'---------------
+'-- Main loop --
+'---------------
+For Each r In Range(TableArray.Cells(1, 1), TableArray.Cells(1, iEndCol))
+    vCurValue = r.value
+    If VarType(vCurValue) = vbString Then
+        strListString = LCase$(Application.Trim(vCurValue))
+        
+        '------------------------------------------------
+        '-- Fuzzy match strings & get percentage match --
+        '------------------------------------------------
+        sngCurPercent = FuzzyPercent(String1:=LookupValue, _
+                                     String2:=strListString, _
+                                     Algorithm:=Algorithm, _
+                                     Normalised:=True)
+        
+        If sngCurPercent >= sngMinPercent Then
+            '---------------------------
+            '-- Store in ranked array --
+            '---------------------------
+            For intRankPtr = 1 To Rank
+                If sngCurPercent > udRankData(intRankPtr).Percentage Then
+                    For intRankPtr1 = Rank To intRankPtr + 1 Step -1
+                        With udRankData(intRankPtr1)
+                            .Offset = udRankData(intRankPtr1 - 1).Offset
+                            .Percentage = udRankData(intRankPtr1 - 1).Percentage
+                        End With
+                    Next intRankPtr1
+                    With udRankData(intRankPtr)
+                        .Offset = r.Column
+                        .Percentage = sngCurPercent
+                    End With
+                    Exit For
+                End If
+            Next intRankPtr
+        End If
+        
+    End If
+Next r
+
+If udRankData(Rank).Percentage < sngMinPercent Then
+    '--------------------------------------
+    '-- Return '#N/A' if below NFPercent --
+    '--------------------------------------
+    FuzzyHLookup = CVErr(xlErrNA)
+Else
+    intBestMatchPtr = udRankData(Rank).Offset - TableArray.Cells(1, 1).Column + 1
+    If IndexNum > 0 Then
+        '-----------------------------------
+        '-- Return row entry specified --
+        '-----------------------------------
+        FuzzyHLookup = TableArray.Cells(IndexNum, intBestMatchPtr)
+    Else
+        '-----------------------
+        '-- Return offset col --
+        '-----------------------
+        FuzzyHLookup = intBestMatchPtr
+    End If
+End If
+End Function
+

+ 69 - 0
microsoft_office/excel/functions/LookupConcat.vba

@@ -0,0 +1,69 @@
+Option Explicit
+
+Function VLookupConcat(Search_string As String, _
+  Search_in_col As Range, Return_val_col As Range)
+
+Dim i As Long
+Dim result As String
+
+For i = 1 To Search_in_col.Count
+  If Search_in_col.Cells(i, 1) = Search_string Then
+    result = result & ", " & Return_val_col.Cells(i, 1).value
+  End If
+Next
+
+VLookupConcat = Trim(result)
+
+End Function
+
+
+Function LookupConcatUnique(Search_string As String, _
+  Search_in_col As Range, Return_val_col As Range)
+
+Dim i As Long
+Dim temp() As Variant
+Dim result As String
+ReDim temp(0)
+
+For i = 1 To Search_in_col.Count
+  If Search_in_col.Cells(i, 1) = Search_string Then
+    temp(UBound(temp)) = Return_val_col.Cells(i, 1).value
+    ReDim Preserve temp(UBound(temp) + 1)
+  End If
+Next
+
+If temp(0) <> "" Then
+    ReDim Preserve temp(UBound(temp) - 1)
+    Unique temp
+    For i = LBound(temp) To UBound(temp)
+        result = result & " " & temp(i)
+    Next i
+    LookupConcatUnique = Trim(result)
+Else
+    LookupConcatUnique = ""
+End If
+
+End Function
+
+Function Unique(tempArray As Variant)
+
+Dim coll As New Collection
+Dim value As Variant
+
+On Error Resume Next
+For Each value In tempArray
+    If Len(value) > 0 Then coll.Add value, CStr(value)
+Next value
+On Error GoTo 0
+
+ReDim tempArray(0)
+
+For Each value In coll
+    tempArray(UBound(tempArray)) = value
+    ReDim Preserve tempArray(UBound(tempArray) + 1)
+Next value
+    
+End Function
+
+
+

+ 15 - 0
microsoft_office/excel/functions/StripAccent.vba

@@ -0,0 +1,15 @@
+Function StripAccent(thestring As String)
+    Dim A As String * 1
+    Dim B As String * 1
+    Dim i As Integer
+    AccChars = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ" & ChrW(337) & ChrW(369) & ChrW(336)
+    RegChars = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy" & "o" & "u" & "O"
+        
+    For i = 1 To Len(AccChars)
+        A = Mid(AccChars, i, 1)
+        B = Mid(RegChars, i, 1)
+        thestring = Replace(thestring, A, B)
+    Next
+    
+    StripAccent = thestring
+End Function

+ 26 - 0
microsoft_office/excel/functions/vreplace.vba

@@ -0,0 +1,26 @@
+Function vreplace(str As String, insep As String, outsep As String, rng As Range, idx As Integer) As String
+    ' Takes a (sep) seperated string (str) like "banana,carrot,apple",
+    ' replaces the elements using vlookup with values from range (rng), column (idx)
+    ' and return as (sep) seperated string
+
+    Dim strArray() As String
+    Dim i As Integer
+    Dim crtStr As String
+    Dim coll As New Collection
+    Set coll = New Collection
+
+    strArray = (Split(str, insep))
+
+    For i = LBound(strArray) To UBound(strArray)
+        'Adding the same value to a collection turns to an error.
+        'Handling the error will skip adding the string to the output
+        crtStr = Application.VLookup(strArray(i), rng, idx, False)
+        On Error GoTo Skip:
+        coll.Add crtStr, crtStr
+        vreplace = vreplace & outsep & crtStr
+Skip: Resume Continue:
+Continue:
+    Next
+    
+    vreplace = Right(vreplace, Len(vreplace) - 1)
+End Function

+ 21 - 0
microsoft_office/excel/macros/Color_String_in_Cell.vba

@@ -0,0 +1,21 @@
+Sub Color_String_in_Cell()
+ Dim rCell As Range
+ Dim X As Long
+ Dim y As Long
+ Dim mystr As String
+ 
+ 'ColorTextInCell.Show
+ 
+ mystr = InputBox("Enter a string")
+ y = Len(mystr)
+ For Each rCell In Selection
+     X = 1
+     Do
+       X = InStr(X, UCase(rCell.value), UCase(mystr))
+       If X > 0 Then
+           rCell.Characters(X, y).Font.Color = vbBlue
+           X = X + 1
+       End If
+     Loop Until X = 0
+ Next rCell
+ End Sub

+ 7 - 0
microsoft_office/excel/macros/EnterAndPressEnter.vba

@@ -0,0 +1,7 @@
+Sub EnterAndPressEnter()
+' Enter all selected cells and press enter
+For Each cell In Selection
+    SendKeys "{F2}", True
+    SendKeys "{ENTER}", True
+Next cell
+End Sub

+ 81 - 0
microsoft_office/excel/macros/FormatHelper.vba

@@ -0,0 +1,81 @@
+Sub HeaderBlue()
+    With Selection.Interior
+        .Pattern = xlSolid
+        .PatternColorIndex = xlAutomatic
+        .ThemeColor = xlThemeColorLight2
+        .TintAndShade = 0.799981688894314
+        .PatternTintAndShade = 0
+    End With
+    Call FormatHeaderFont
+    Call FormatBorders
+End Sub
+
+Sub HeaderGrey()
+    With Selection.Interior
+        .Pattern = xlSolid
+        .PatternColorIndex = xlAutomatic
+        .ThemeColor = xlThemeColorDark1
+        .TintAndShade = -0.149998474074526
+        .PatternTintAndShade = 0
+    End With
+    Call FormatHeaderFont
+    Call FormatBorders
+End Sub
+
+Private Sub FormatHeaderFont()
+    With Selection.Font
+        .Color = RGB(0, 0, 0)
+        .Bold = True
+        .Name = "Arial"
+        .Size = "8"
+    End With
+End Sub
+
+    
+Private Sub FormatBorders()
+    ' Border Diagonal
+    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
+    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
+
+    ' Border Left
+    With Selection.Borders(xlEdgeLeft)
+        .LineStyle = xlContinuous
+        .ColorIndex = xlAutomatic
+        .TintAndShade = 0
+        .Weight = xlThin
+    End With
+
+    'Border Right
+    With Selection.Borders(xlEdgeRight)
+        .LineStyle = xlContinuous
+        .ColorIndex = xlAutomatic
+        .TintAndShade = 0
+        .Weight = xlThin
+    End With
+    
+    'Border Inside
+    With Selection.Borders(xlInsideVertical)
+        .LineStyle = xlContinuous
+        .ColorIndex = xlAutomatic
+        .TintAndShade = 0
+        .Weight = xlThin
+    End With
+      
+    'Border Top
+    With Selection.Borders(xlEdgeTop)
+        .LineStyle = xlContinuous
+        .ColorIndex = xlAutomatic
+        .TintAndShade = 0
+        .Weight = xlMedium
+    End With
+    
+    'Border Bottom
+    With Selection.Borders(xlEdgeBottom)
+        .LineStyle = xlContinuous
+        .ColorIndex = xlAutomatic
+        .TintAndShade = 0
+        .Weight = xlThin
+    End With
+     
+    
+End Sub

+ 32 - 0
microsoft_office/excel/macros/GetPassword.vba

@@ -0,0 +1,32 @@
+Sub GetPassword()
+  'Author unknown but submitted by brettdj of www.experts-exchange.com
+
+  Dim i As Integer, j As Integer, k As Integer
+  Dim l As Integer, m As Integer, n As Integer
+  Dim i1 As Integer, i2 As Integer, i3 As Integer
+  Dim i4 As Integer, i5 As Integer, i6 As Integer
+  On Error Resume Next
+  For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
+  For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
+  For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
+  For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
+
+
+ ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _
+      Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
+      Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
+  If ActiveSheet.ProtectContents = False Then
+      MsgBox "One usable password is " & Chr(i) & Chr(j) & _
+          Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
+          Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
+   ActiveWorkbook.Sheets(1).Select
+   Range("a1").FormulaR1C1 = Chr(i) & Chr(j) & _
+          Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
+          Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
+       Exit Sub
+  End If
+  Next: Next: Next: Next: Next: Next
+  Next: Next: Next: Next: Next: Next
+
+
+End Sub

+ 116 - 0
microsoft_office/excel/macros/MatrixToList.vba

@@ -0,0 +1,116 @@
+Public mtrx, dbase, v As String
+Public ro, col, newro, newcol, rotot, coltot, all, rowz, colz, tot As Integer
+
+Sub Matrix()
+
+' Macro created 11/16/2005 by Peter T Oboyski (updated 8/24/2006)
+' The Macro was turned into an "add in" by Thirsa Kraaijenbrink
+' You are welcome to redistribute this macro, but if you make substantial
+' changes to it, please indicate so in this section along with your name.
+' This Macro converts matrix-type spreadsheets (eg. plot x species data) into column data
+' The new (converted) spreadsheet name is "DB of 'name of active spreadsheet'"
+' The Macro assumes the matrix begins in the upper left cells of the spreadsheet.
+' The conversion allows for multiple header rows and columns.
+' Because of a quirk in how Excel handles blanks and zeroes I had to create two options:
+' one which includes zero and negative values and empty cells,
+' and one which ignores these - sorry for any inconvenience.
+
+'-----------------------------------------------------------------------------
+' This section asks about data types, row headers, and column headers
+
+all = MsgBox("Include zero, negative, and empty cells?", vbYesNoCancel)
+rowz = InputBox("How many HEADER ROWS?", "Header Rows & Columns")
+colz = InputBox("How many HEADER COLUMNS?", "Header Rows & Columns")
+
+'-----------------------------------------------------------------------------
+' This section allows the user to provide field (column) names for the new spreadsheet
+
+Dim Arr(10) As Variant
+newcol = 1
+For r = 1 To rowz
+    Arr(newcol) = InputBox("Field name for row " & r)
+    newcol = newcol + 1
+Next
+For c = 1 To colz
+    Arr(newcol) = InputBox("Field name for column " & c)
+    newcol = newcol + 1
+Next
+Arr(newcol) = "Data"
+v = newcol
+
+'-----------------------------------------------------------------------------
+' This section creates the new spreadsheet and names it
+
+mtrx = ActiveSheet.Name
+Sheets.Add
+dbase = "DB of " & mtrx
+ActiveSheet.Name = dbase
+
+'-----------------------------------------------------------------------------
+'This section determines how many rows and columns the matrix has
+
+dun = False
+rotot = rowz + 1
+Do
+    If (Sheets(mtrx).Cells(rotot, 1) > 0) Then
+        rotot = rotot + 1
+    Else
+        dun = True
+    End If
+Loop Until dun
+rotot = rotot - 1
+
+dun = False
+coltot = colz + 1
+Do
+    If (Sheets(mtrx).Cells(1, coltot) > 0) Then
+        coltot = coltot + 1
+    Else
+        dun = True
+    End If
+Loop Until dun
+coltot = coltot - 1
+
+'-----------------------------------------------------------------------------
+'This section writes the new field names to the new spreadsheet
+
+For newcol = 1 To v
+    Sheets(dbase).Cells(1, newcol) = Arr(newcol)
+Next
+
+'-----------------------------------------------------------------------------
+'This section actually does the conversion
+
+Dim tot As Long
+tot = 0
+newro = 2
+For col = (colz + 1) To coltot
+    For ro = (rowz + 1) To rotot 'the next line determines if data are nonzero
+        If ((Sheets(mtrx).Cells(ro, col) > 0) Or (all = 6)) Then
+            tot = tot + 1
+            newcol = 1
+            For r = 1 To rowz            'the next line copies the row headers
+                Sheets(dbase).Cells(newro, newcol) = Sheets(mtrx).Cells(r, col)
+                newcol = newcol + 1
+            Next
+            For c = 1 To colz         'the next line copies the column headers
+                Sheets(dbase).Cells(newro, newcol) = Sheets(mtrx).Cells(ro, c)
+                newcol = newcol + 1
+            Next                                'the next line copies the data
+            Sheets(dbase).Cells(newro, newcol) = Sheets(mtrx).Cells(ro, col)
+            newro = newro + 1
+        End If
+    Next
+Next
+
+'-----------------------------------------------------------------------------
+'This section displays a message box with information about the conversion
+
+book = "Original matrix = " & ActiveWorkbook.Name & ": " & mtrx & Chr(10)
+head = "Matrix with " & rowz & " row headers and " & colz & " column headers" & Chr(10)
+cels = tot & " cells of " & ((rotot - rowz) * (coltot - colz)) & " with data"
+
+MsgBox (book & head & cels)
+
+End Sub
+

+ 11 - 0
microsoft_office/excel/macros/Personal_Macro_Workbook_to_Clipboard.vba

@@ -0,0 +1,11 @@
+Sub Personal_Macro_Workbook_to_Clipboard()
+    Dim myData As DataObject
+    Dim Output As String
+    Output = Application.StartupPath + "\Personal.xlsb"
+    Set myData = New DataObject
+    myData.SetText Output
+    myData.PutInClipboard
+    MsgBox Output, vbOKOnly, "Personal Macro Workbook"
+End Sub
+
+

+ 14 - 0
microsoft_office/excel/macros/SpitWorkSheetsInFiles.vba

@@ -0,0 +1,14 @@
+Sub Splitbook()
+'Updateby20140612
+Dim xPath As String
+xPath = Application.ActiveWorkbook.Path
+Application.ScreenUpdating = False
+Application.DisplayAlerts = False
+For Each xWs In ThisWorkbook.Sheets
+    xWs.Copy
+    Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
+    Application.ActiveWorkbook.Close False
+Next
+Application.DisplayAlerts = True
+Application.ScreenUpdating = True
+End Sub

+ 45 - 0
microsoft_office/excel/macros/combine_sheets.vba

@@ -0,0 +1,45 @@
+Sub CombineSheetsIntoSheet()
+    Dim wb As Workbook
+    Dim j As Integer, wsNew As Worksheet
+    Dim rngCopy As Range, rngPaste As Range
+    Dim Location As String
+
+    Set wb = ActiveWorkbook
+
+    On Error Resume Next
+    Set wsNew = wb.Sheets("Combined")
+    On Error GoTo 0
+        'if sheet does not already exist, create it
+        If wsNew Is Nothing Then
+        Set wsNew = wb.Worksheets.Add(before:=wb.Sheets(1)) ' add a sheet in first place
+        wsNew.Name = "Combined"
+    End If
+
+    'copy headings and paste to new sheet starting in B1
+    With wb.Sheets(2)
+        .Range(.Range("A1"), .Cells(1, Columns.Count) _
+                   .End(xlToLeft)).Copy wsNew.Range("B1")
+    End With
+
+    ' work through sheets
+    For j = 2 To wb.Sheets.Count ' from sheet 2 to last sheet
+        'save sheet name/location to string
+        Location = wb.Sheets(j).Name
+
+        'set range to be copied
+        With wb.Sheets(j).Range("A1").CurrentRegion
+            Set rngCopy = .Offset(1, 0).Resize(.Rows.Count - 1)
+        End With
+
+        'set range to paste to, beginning with column B
+        Set rngPaste = wsNew.Cells(Rows.Count, 2).End(xlUp).Offset(2, 0)
+
+        'copy range and paste to column *B* of combined sheet
+        rngCopy.Copy rngPaste
+
+        'enter the location name in column A for all copied entries
+        wsNew.Range(rngPaste, rngPaste.End(xlDown)).Offset(0, -1) = Location
+
+    Next j
+
+End Sub

o365/custom-theme.md → microsoft_office/office_365/custom-theme.md


+ 3 - 0
python/contactsync/.gitignore

@@ -0,0 +1,3 @@
+book.csv
+contacts/
+status/

+ 21 - 0
python/contactsync/INSTALL.Dependencies.Windows.md

@@ -0,0 +1,21 @@
+## Install Python
+  - Download: https://www.python.org/downloads/windows/
+    - Install for all users and add to PATH
+  - Download: https://support.microsoft.com/en-us/help/2977003/the-latest-supported-visual-c-downloads
+    - Install
+
+## Install Git
+  - https://git-scm.com/download/win
+
+## Install vdirsyncer
+  1. Run `cmd` as administrator
+  2. `pip install vdirsyncer`
+
+## Prepare programm folder
+`mkdir %userprofile%\bin\contactsync`
+  - This folder should be ONLY ACCESSABLE by the user as passwords are stored in plaintext
+  - All scripts and configurations are located here
+  - ./contacts with vcards will be synced here
+  - ./book.csv will be created here
+  - The macro will execute run.bat from here and pulls book.csv from here
+

+ 35 - 0
python/contactsync/README.md

@@ -0,0 +1,35 @@
+# Calendarsync
+Purpose of this project is to replicate contacts from CardDAV to Microsoft Excel.
+
+### Components:
+- Docker Container to test vdirsync (start-docker-container.sh)
+- Windows shell script (vdirsync.bat) to run vdirsync
+- Python script to parse carddav files to csv (parse-vcf.py)
+- Script to start the vdirsync and parse script (run.bat)
+- PowerQuery to load CSV to Excel (powerquery.txt)
+- VBA script to update Excel with the CSV file (excel.vba)
+
+### Pipeline:
+- User clicks button in Excel which runs the load vba function
+- vba starts run.bat and consequently
+  - vdirsync pulls latest vcard files (*.vcf) to ./contacts/
+  - parse-vcf.py parses the vcards to book.csv
+- vba pulls the data via powerquery from `%userprofile%\bin\contactsync\book.csv` 
+
+
+## Configuration
+For Linux, set your address book url, username and password here:
+  - data/carddav.url
+  - data/password
+  - data/username
+
+Set your book url, username and password here:
+  - config-windows.txt
+
+## Testing
+- For testing under Linux, set your address book url, username and password here:
+  - carddav.url
+  - password
+  - username
+- `run.bat` equvivalent is `run.sh`
+- `vdirsync.bat` equvivalent is `vdirsync.sh`

+ 21 - 0
python/contactsync/config-windows.txt

@@ -0,0 +1,21 @@
+[general]
+status_path = "status"
+
+[pair contacts]
+a = "local_card"
+b = "remote_card"
+collections = ["from a", "from b"]
+conflict_resolution = "b wins"
+metadata = ["displayname"]
+
+[storage local_card]
+type = "filesystem"
+path = "contacts"
+fileext = ".vcf"
+
+[storage remote_card]
+type = "carddav"
+url = "https://dav.ulm.org/addressbooks/johndoe@ulm.org"
+username = "johndoe@ulm.org" 
+password = "EnterYourPasswordHere"
+

+ 17 - 0
python/contactsync/excel.vba

@@ -0,0 +1,17 @@
+Sub load()
+progpath = Environ("USERPROFILE") & "\bin\contactsync"
+
+' Shell Runs async
+'ChDir progpath
+'Shell progpath & "\test.bat", vbNormalFocus
+
+' wsh runs sync
+Dim wsh As Object
+Set wsh = VBA.CreateObject("WScript.Shell")
+Dim waitOnReturn As Boolean: waitOnReturn = True
+Dim windowStyle As Integer: windowStyle = 1
+wsh.Run progpath & "\test.bat", windowStyle, waitOnReturn
+
+
+Range("book").ListObject.QueryTable.Refresh BackgroundQuery:=False
+End Sub

+ 42 - 0
python/contactsync/parse-vcf.py

@@ -0,0 +1,42 @@
+#!/usr/bin/python3
+
+import os
+import glob
+
+# Open (create if not exists) file, truncate and write csv header
+csv=open("book.csv","w+")
+csv.truncate(0)
+csv.write('org;fullname;street;city;zip\n')
+
+# Parse all contacts
+for file in glob.glob('./contacts/*/*.vcf'):
+  
+  # Empty variables to get rid of relicts from previous files
+  fn = po_box = ext_address = street = city = region = zip = country = org = ""
+
+  for line in open(file):
+    if "FN:" in line:
+      print(file)
+      print(line)
+      fn=line.rstrip().replace("FN:","")
+      continue
+    if "ADR;" in line:
+      print(line)
+      adr=line.rstrip().split(':', 1)[-1].split(';')
+      po_box=adr[0]
+      ext_address=adr[1]
+      street=adr[2]
+      city=adr[3]
+      region=adr[4]
+      zip=str(adr[5])
+      country=adr[6]
+      continue
+    if "ORG:" in line:
+      print(line)
+      org=str(line.rstrip().replace("ORG:","").split(';')[0])
+      continue
+    
+  if len(org) > 0:
+    csv.write(org+';'+fn+';'+street+';'+city+';'+zip+'\n')
+    
+csv.close()

+ 3 - 0
python/contactsync/powerquery.md

@@ -0,0 +1,3 @@
+- Erste Zeile als Überschrift verwenden
+- Alle Felder als String, speziell [zip] und [org]
+- Additional "FullAddress" field: `=[fn]&Character.FromNumber(10)&[street]&Character.FromNumber(10)&[zip]&" "&[city]`

+ 2 - 0
python/contactsync/run.bat

@@ -0,0 +1,2 @@
+call vdirsyncer.bat
+python3 parse-vcf.py

+ 1 - 0
python/contactsync/tests/linux-testbed/carddav.url

@@ -0,0 +1 @@
+https://dav.ulm.org/addressbooks/johndoe@ulm.org

+ 21 - 0
python/contactsync/tests/linux-testbed/config

@@ -0,0 +1,21 @@
+[general]
+status_path = "status"
+
+[pair contacts]
+a = "local_card"
+b = "remote_card"
+collections = ["from a", "from b"]
+conflict_resolution = "b wins"
+metadata = ["displayname"]
+
+[storage local_card]
+type = "filesystem"
+path = "contacts"
+fileext = ".vcf"
+
+[storage remote_card]
+type = "carddav"
+url.fetch  = ["command", "cat", "carddav.url"]
+username.fetch = ["command", "cat", "username"]
+password.fetch = ["command", "cat", "password"]
+

+ 1 - 0
python/contactsync/tests/linux-testbed/password

@@ -0,0 +1 @@
+EnterYourPasswordHere

+ 4 - 0
python/contactsync/tests/linux-testbed/run.sh

@@ -0,0 +1,4 @@
+#!/bin/bash
+./vdirsyncer.sh
+./parse-vcf.py
+chown -R 1000:1000 contacts status book.csv 

+ 4 - 0
python/contactsync/tests/linux-testbed/start-docker-container.sh

@@ -0,0 +1,4 @@
+#!/bin/bash
+docker run -it --rm --volume `pwd`/data:/data \
+           --hostname vdirsyncer --name vdirsyncer \
+	   --workdir /data python /data/run.sh

+ 1 - 0
python/contactsync/tests/linux-testbed/username

@@ -0,0 +1 @@
+johndoe@ulm.org

+ 5 - 0
python/contactsync/tests/linux-testbed/vdirsyncer.sh

@@ -0,0 +1,5 @@
+#!/bin/bash
+pip install vdirsyncer
+yes | vdirsyncer -c config discover
+vdirsyncer -c config metasync
+vdirsyncer -c config sync

+ 2 - 0
python/contactsync/tests/test.bat

@@ -0,0 +1,2 @@
+time /t >> book.csv
+timeout /t 3

+ 3 - 0
python/contactsync/vdirsyncer.bat

@@ -0,0 +1,3 @@
+echo yes | vdirsyncer -c config-windows.txt discover
+vdirsyncer -c config-windows.txt metasync
+vdirsyncer -c config-windows.txt sync