'Removes (regrettably) ADS file comments (right-click / properties) and 'inserts the comment data directly into the JPG file as a JPG comment. Option Explicit Main Sub Main Dim strComment, ws, fs Set fs = CreateObject("Scripting.FileSystemObject") Set ws = CreateObject("Wscript.Shell") If WScript.Arguments.Count <> 1 Then MsgBox "Drop a JPG file on me to move the file comment into a JPG comment." Exit Sub End If If Not fs.FileExists(WScript.Arguments(0)) Then MsgBox "Drop a JPG file on me to move the file comment into a JPG comment." Exit Sub End If strComment = Trim(GetAdsComments(WScript.Arguments(0))) If strComment <> "" Then If CommandExists("exiv2.exe", "Usage") Then ws.Run "exiv2.exe -c """ & strComment & """ """ & WScript.Arguments(0) & """", 0, True 'exiv2 -M "set Iptc.Application2.Caption String This is an IPTC caption!" test.jpg 'exiv2 -M "set Iptc.Application2.Headline String This is an IPTC headline!" test.jpg 'exiv2 -M "set Exif.Photo.UserComment charset=Ascii New Exif comment" test.jpg 'exiv2 -M "set Exif.Image.ImageDescription charset=Ascii New Exif comment" test.jpg ElseIf CommandExists("jhead.exe", "No files to process") Then ws.Run "jhead.exe -cl """ & strComment & """ """ & WScript.Arguments(0) & """", 0, True ElseIf CommandExists("exiftool.exe", "SYNOPSIS") Then ws.Run "exiftool -overwrite_original -comment=""" & strComment & """ """ & WScript.Arguments(0) & """", 0, True Else If MsgBox("You need one of the following tools in your %PATH%:" & vbCrLf _ & "EXIV2 - http://www.exiv2.org/download.html" & vbCrLf _ & "JHEAD - http://www.sentex.net/~mwandel/jhead/" & vbCrLf _ & "EXIF TOOL - http://www.sno.phy.queensu.ca/~phil/exiftool/" & vbCrLf _ & "Press OK to be taken to the EXIV2 download page.", vbOKCancel, "Program Dependency") = vbOk Then ws.Run "http://www.exiv2.org/download.html", 1, False End If End If Else 'MsgBox "There weren't any file comments!" End If End Sub Function GetAdsComments(strFile) Const FILE_NAME = 0 Dim shFile, strOut, intComment, sh, shFol, fs Set fs = CreateObject("Scripting.FileSystemObject") Set sh = CreateObject("Shell.Application") Set shFol = sh.Namespace(fs.GetParentFolderName(strFile)) strOut = "" 'Find out what item holds the ADS "Comment" data (varies between OS) intComment = -1 On Error Resume Next 'In case elements don't go as high as 37 For intComment = 0 To 37 If "Comment" = shFol.GetDetailsOf(shFol.Items, intComment) Then Exit For End If Next If intComment = -1 Then GetAdsComments = "" Exit Function End If 'Iterate through the folder until we find our file For Each shFile in shFol.Items If fs.GetFileName(strFile) = shFol.GetDetailsOf(shFile, FILE_NAME) Then GetAdsComments = shFol.GetDetailsOf(shFile, intComment) Exit Function End If Next GetAdsComments = "" End Function Function CommandExists(strCommand, strProof) 'Returns true if a command line utility will run. 'Enter the command and some text that appears in the command output. Dim strData, app, ws, intMaxCount, intCount On Error Resume Next Set ws = CreateObject("Wscript.Shell") strData = "" intMaxCount = 10 'A one-second max time since each loop is 1/10 of a second intCount = 0 Err.Clear Set app = ws.Exec(strCommand) If Err.Number = 0 Then Do While app.Status = 0 WScript.Sleep 100 intCount = intCount + 1 'Keep track of how many times we've waited. If intCount > intMaxCount Then Exit Do 'Don't get stuck waiting for user input. Loop strData = app.StdOut.ReadAll strData = strData & app.StdErr.ReadAll End If If strData = "" Then CommandExists = False Else If InStr(strData, strProof) = 0 Then CommandExists = False Else CommandExists = True End If End If End Function