Const ForReading = 1

InDir = "C:\Temp\Staff Photos"
Set fso = CreateObject("Scripting.FileSystemObject")

set oIADS = GetObject("LDAP://RootDSE")
strDefaultNC = oIADS.Get("defaultnamingcontext")

Set theConn = CreateObject("ADODB.Connection")
theConn.Provider = "ADsDSOObject"
theConn.Open "ADs Provider"

Set theCmd  = CreateObject("ADODB.Command")
theCmd.ActiveConnection = theConn
Set objRecordSet = CreateObject("ADODB.Recordset")

For Each tFile In fso.GetFolder(InDir).Files
    tName = tFile.Name
    'Gets the persons Name from the file by stripping the extention.
    tName = Left(tName, InStrRev(tName,".")-1)
     
    'You may need to tweak this bit depending on your naming conventions.      
    strQuery = "<LDAP://" & strDefaultNC & ">;" & _
                              "(&(objectClass=person)(name=" & tName & "));name,adspath;subtree"
    theCmd.CommandText = strQuery
    Set objRS = theCmd.Execute

    If objRS.RecordCount = 0 Then
       MsgBox "Can't find account for " & tName
    Else
       Set objUser = GetObject(objRS("adspath"))

       ObjUser.Put "jpegPhoto", ReadByteArray(tFile.Path)
       ObjUser.SetInfo
    End If
Next


'Stolen from http://www.ericphelps.com/q193998/index.htm
Function ReadByteArray(strFileName)
     Const adTypeBinary = 1
     Dim bin
     Set bin = CreateObject("ADODB.Stream")
     bin.Type = adTypeBinary
     bin.Open
     bin.LoadFromFile strFileName
     ReadByteArray = bin.Read
End Function