Jun 05 2021 08:47 PM
I have downloaded existing data from Active Directory to an Excel worksheet. Now I want the data in the sheet to be synced with Active Directory once a day so that changes in Active Directory are updated in the Excel file.
Can someone help please?
I am using Office 365, Windows 10.
Jun 06 2021 05:55 AM
Syncing Excel Worksheet to Active Directory
Adjust or synchronize a directory including subdirectories via VBA.
In the end, the content must be completely uniform on both sides.
In the target folder, delete the files / directories that are not the same as the source folder.
In the end, both sides (source and destination) are completely the same.
Source = "D: \ Projects \ Service \ Nikolino \ 2021 \ Mystery \"
Target = "S: \ Backup \ Projects \ Service \ Nikolino \ 2021 \ Mystery \"
Option Explicit
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (_
ByVal DirPath As String) As Long
Private Declare Function CopyFileA Lib "kernel32.dll" (_
ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long
Syncronize Public Sub ()
Const QUELLE As String = "D: \ Projects \ Service \ Nikolino \ 2021 \ Mystery \"
Const ZIEL As String = "S: \ Backup \ Projects \ Service \ Nikolino \ 2021 \ Mystery \"
Dim astrFolders () As String, strFilename As String
Dim ialngFoldes As Long, lngLen As Long
Dim objFileSystemObject As Object
If Dir $ (TARGET, vbDirectory) <> vbNullString Then
Set objFileSystemObject = CreateObject ("Scripting.FileSystemObject")
Call objFileSystemObject.DeleteFolder (Left $ (ZIEL, Len (ZIEL) - 1), True)
Set objFileSystemObject = Nothing
End If
lngLen = Len (SOURCE) + 1
astrFolders = GetFolders (SOURCE)
For ialngFoldes = LBound (astrFolders) To UBound (astrFolders)
Call MakeSureDirectoryPathExists (ZIEL & Mid $ (astrFolders (ialngFoldes), lngLen))
Next
For ialngFoldes = LBound (astrFolders) To UBound (astrFolders)
strFilename = Dir $ (astrFolders (ialngFoldes) & "*. *")
Do Until strFilename = vbNullString
Call CopyFileA (astrFolders (ialngFoldes) & strFilename, _
ZIEL & Mid $ (astrFolders (ialngFoldes), lngLen) & strFilename, 0)
strFilename = Dir $
Loop
Next
End Sub
Private Function GetFolders (ByVal pvstrPath As String) As String ()
Dim astrFolders () As String
Dim strFolder As String, strPath As String
Dim ialngIndex1 As Long, ialngIndex2 As Long
strPath = pvstrPath
Redim astrFolders (0 To 0)
astrFolders (0) = pvstrPath
ialngIndex1 = 1
do
strFolder = Dir $ (strPath & "*", vbDirectory)
Do Until strFolder = vbNullString
If strFolder <> "." And strFolder <> ".." Then
If GetAttr (strPath & strFolder) And vbDirectory Then
Redim Preserve astrFolders (0 To ialngIndex1)
astrFolders (ialngIndex1) = strPath & strFolder & "\"
ialngIndex1 = ialngIndex1 + 1
End If
End If
strFolder = Dir $
Loop
If ialngIndex1 = ialngIndex2 Then Exit Do
strPath = astrFolders (ialngIndex2)
ialngIndex2 = ialngIndex2 + 1
Loop
GetFolders = astrFolders
End function
I would be happy to know if I could help.
Nikolino
I know I don't know anything (Socrates)
* Kindly Mark and Vote this reply if it helps please, as it will be beneficial to more Community members reading here