If you don't know it, have a look at http://www.photools.com/
These Scripts can be used any way, but also without any kind of warranty!
If you don't agree, please leave now.
= new Script
= updated Script
Multi Database Transmission V 1.2 (06-Jun-2003) - This script transmits Images from a SourceDB to a TargetDB, preserving all Category-Assignments and Property-Entries. (And, *g*, if Mario would give us an updated Timestamp for the DatabaseImageRecords, we could merge Databases by checking which Entry is newer. Think about mobile IMatch.)
Remove Empty Categories from Database V 1.0 (30-May-2003) - This script removes all 'empty'-Categories from the active Database.
OffLineCache Garbage Collector V 1.0 (28-Jun-2003) - This script checks all existing Images in OfflineCacheFolder of the active Database and deletes ownerless OLC-Images. Additionally you can select some Categories from which you want delete the Images OfflineCache-pendants.
Photoshop Conversion (PS 5.5 + 6) V 0.9 (02-Jul-2003) - This Script combines the ManagementPower of IMatch with the ImageManipulationPower of Adobes Photoshop 6.0 in an easy to use way. This Script I have written together with Klaus Schwarzburg. Many thanks for your help, Klaus.
lcms Webgallery Creator V 0.1 (05-Oct-2002) - This script enhance the original Webgallery-Creator-Script with an ICC-Conversion-feature.
little Batch Converter V 1.2 (26-Jun-2003) - This script create resized copies, optionally with ICC-Conversion for Tiff- and Jpeg-sources. Can work with OfflineCacheImages instead of originals and can transmit all Property-, Category- and IPTC-data to the copies.
Registry Functions V 1.0 (01-Nov-2002) - A littleHelper-Script to put and retrieve Data to/from Registry in its correct DataTypes. VB usually provides only the StringType. With this Lib you can store every DataType to Registry (Byte, Integer, Long, Double, Decimal, Boolean, Variant, ...).
Debug Messages V 1.0 (08-Nov-2002) - A littleHelper-Script which handles Debugoutput in Priorityclasses. With this you can have good Informationoutput when you develope a Script and a less or no Output when run the Script in Productivity-Mode. Your DebugmessagePoints can stay in code without any (auswirkung). Usefull for future changes on your code.
Explanation
MainScript: hn_MultiDBTransmission.bas
Needed Modules: [hnClsRegKey.cls]
[hnClsTransmission.cls]
[hnFncUtils.lib]
[hnPublicDeclarations.lib]
hnClsTransmission.cls: (628 lines / 322 real codelines / 0 Subs / 0 Functions / 12 Properties)
1| VERSION 1.0 CLASS 2| BEGIN 3| MultiUse = -1 'True 4| END 5| Attribute VB_PredeclaredId = False 6| Attribute VB_Creatable = True 7| Attribute VB_Exposed = True 8| Attribute VB_GlobalNameSpace = False 9| Attribute VB_Name = "clsTransmission" 10| '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 11| ' 12| 13| ' 14| ' h.nogajski@web.de 15| ' http://horst.nogajski.de 16| ' 17| '-------------------------------------------------------------------------------------------------- 18| ' 19| ' Transmission Class (for IMatch SAX-Basic) 20| ' 21| ' With this class you can transmit Properties, Categories, IPTC and EXIF-Data from a 22| ' SoureceImage to a TargetImage. The Source and Target also can be in different Databases. 23| ' 24| ' 25| 'V 0.3 (04-Jun-2003) 26| ' 27| '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 28| '-------------------------------------------------------------------------------------------------- 29| ' 30| ' Uses / Embedds 31| ' 32| '#uses "hnPublicDeclarations.lib" 33| '#uses "hnFncUtils.lib" => Needs the IMatch 3 Scripthelping Type Library embedded 34| '#uses "hnClsRegKey.cls" 35| ' 36| '-------------------------------------------------------------------------------------------------- 37| ' 38| ' Public Functions: 39| ' 40| ' ------------------------------------------------------------------------------------------- 41| ' ClsVersion 42| ' Descript: Returns the revision Version of this Class, 43| ' To allow testing For downward compatibility 44| ' two digits per position, allows for versions such as V 20.12.29 45| ' last position not used in String now 46| ' (could be used for internal releases for example), set to 00 in Long 47| ' Returns: Long 48| ' ------------------------------------------------------------------------------------------- 49| ' ClsVersionString 50| ' Returns: String 51| ' ------------------------------------------------------------------------------------------- 52| ' ClsName 53| ' Descript: returns the Private Const SCRIPTNAME 54| ' Returns: String 55| ' ------------------------------------------------------------------------------------------- 56| ' CheckVersionAgainst 57| ' Descript: Checks a given Long against the ClassVersionNumber. 58| ' The given Long represents the ClassVersionNumber of the Class which a 59| ' ScriptAuthor has used creating his script. 60| ' Params: Long neededLong, Optional Boolean suppressMsgBox 61| ' Returns: Boolean 62| ' ------------------------------------------------------------------------------------------- 63| ' ClassInit 64| ' Descript: Initializes the class instance. Returncodes are: 65| ' 0 for an Error / couldn't be initialized 66| ' -1 for successfull initialization 67| ' 1 if it is already initialized 68| ' Params: RegKeyClassInstance; SourceDB; TargetDB; BooleanDoDebug; 69| ' Returns: Integer 70| ' ------------------------------------------------------------------------------------------- 71| ' ClassUNSET 72| ' Descript: Clears all values of all modulglobal-variables 73| ' After that, the class must/can be initialized again for further using 74| ' Returns: Boolean 75| ' ------------------------------------------------------------------------------------------- 76| ' TransmitProperties 77| ' Descript: Transmit all Properties from SourceImage to TargetImage 78| ' Params: Image: SourceImage, TargetImage 79| ' Returns: Boolean 80| ' ------------------------------------------------------------------------------------------- 81| ' TransmitCategories 82| ' Descript: Transmit all Categories from SourceImage to TargetImage 83| ' Params: Image: SourceImage, TargetImage 84| ' Returns: Boolean 85| ' ------------------------------------------------------------------------------------------- 86| ' TransmitIPTC 87| ' Descript: Transmit all IPTC-Data from SourceImage to TargetImage 88| ' Params: Image: SourceImage, TargetImage 89| ' Returns: Boolean 90| ' ------------------------------------------------------------------------------------------- 91| ' TransmitAllSelected 92| ' Descript: Transmit Props, Cats IPTC, EXIF, if they were selected by TheDialog 93| ' Params: Image: SourceImage, TargetImage 94| ' Returns: Boolean 95| ' ------------------------------------------------------------------------------------------- 96| ' TheDialog 97| ' Descript: Opens a Dialog which lets the user select TransmissionGroups and stores it in Registry 98| ' Params: none 99| ' Returns: Boolean 100| ' ------------------------------------------------------------------------------------------- 101| ' DisplaySelectedTransmissions 102| ' Descript: Returns a string, which Groups are selected in TheDialog and now stored in Registry 103| ' Params: none 104| ' Returns: String 105| ' 106| '-------------------------------------------------------------------------------------------------- 107| ' 108| ' Private Functions: 109| ' 110| ' 111| '-------------------------------------------------------------------------------------------------- 112| ' 113| ' VersionChanges: 114| ' 115| ' V 0.1 (02-Apr-2003) initial release 116| ' includes: TransmitProperties; TransmitCategories; 117| ' 118| ' V 0.2 (28-May-2003) new: TransmitIPTC; TransmitAllSelected; 119| ' TheDialog; DisplaySelectedTransmissions; 120| ' also the Functionality now is enhanced for working with multiple 121| ' Databases (Source and Target); 122| ' 123| ' V 0.3 (28-May-2003) changed: TransmitIPTC; 124| ' 125| ' 126| '-------------------------------------------------------------------------------------------------- 127| ' 128| ' Credits: 129| ' 130| ' MainCode of TransmitProperties was taken from another IMatch-UserScript: 131| ' CreateWorkingCopy - a script by Peter Poorman and Alan Gant 132| ' Copyright 2002 by Peter Poorman 133| ' 134| '-------------------------------------------------------------------------------------------------- 135| '|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 136| 137| 138| Option Explicit 139| 140| 141| 'ClassVersion/String 142| Private Const ClassVersionString As String = "V 0.3 (04-Jun-2003)" 143| Private Const ClassVersion As Long = 3000 144| 145| 'SCRIPTNAME is needed for MsgBoxTitles etc. 146| Private Const SCRIPTNAME As String = "TransmissionClass" 147| 148| 149| 'Dialog Textphrases 150| Private Const TEXTPHRASE_000 As String = "select Transmissions" 'Dialog-Checkbox: DialogBox-Title 151| Private Const TEXTPHRASE_006 As String = "nutze PS-autoZuweisung" 'Dialog-Checkbox: use AutoAssign with PS 152| Private Const TEXTPHRASE_007 As String = "transmit Properties" 'Dialog-Checkbox: transmit Properties 153| Private Const TEXTPHRASE_008 As String = "transmit Categories" 'Dialog-Checkbox: transmit Categories 154| Private Const TEXTPHRASE_013 As String = "transmit IPTC-Data" 'Dialog-Checkbox: transmit IPTC-Data 155| Private Const TEXTPHRASE_014 As String = "transmit EXIF-Data" 'Dialog-Checkbox: transmit Exif-Data 156| 157| 158| 159| 'ClassInit() 160| Private bClassReady As Boolean 161| Private bSuppressClassNotReadyMsg As Boolean 162| Private bDebugging As Boolean 163| 164| 165| 166| 'The Variables, Arrays and Objects 167| Private Reg As clsRegKey 'holds a given RegKeyClassObject or optional a 'Standalone'-RegKeyClassObject 168| Private SourceDB As Database 'holds a given DatabaseObject or optional the active DatabaseObject 169| Private TargetDB As Database 'holds a given DatabaseObject or optional the active DatabaseObject 170| Private ImageCategories As Categories 171| Private cat As Category 172| Private iptc As IPTCStream 173| Private PropSet As PropertySet 174| Private PropSetProp As PropertySetProperty 175| Private SourceImgPropRec As PropertyRecord 176| Private TargetImgPropRec As PropertyRecord 177| Private TargetPropSet As PropertySet 178| Private TargetPropRec As PropertyRecord 179| Private userPropertyCount As Long 180| Private variantK As Variant 181| Private j As Long 182| Private k As Long 183| 184| 185| 186| Public Property Get ClsVersion() As Long 187| ClsVersion = ClassVersion 188| End Property 189| 190| Public Property Get ClsVersionString() As String 191| ClsVersionString = ClassVersionString 192| End Property 193| 194| Public Property Get ClsName() As String 195| ClsName = SCRIPTNAME 196| End Property 197| 198| Public Property Get CheckVersionAgainst(ByRef neededLong As Long, Optional ByRef suppressMsgBox As Boolean = False) As Boolean 199| If neededLong <= ClassVersion Then 200| CheckVersionAgainst = True 201| Else 202| CheckVersionAgainst = False 203| If Not suppressMsgBox Then 204| MsgBox "The version of the " & SCRIPTNAME & " is to old: " & ClassVersionString & " = long(" & ClassVersion & ")" & vbNewLine & vbNewLine & _ 205| "Maybe that you have overwritten the file contained in the ZIP file of this Script" & vbNewLine & _ 206| "with an outdated version delivered with another script in your Script folder." & vbNewLine & vbNewLine & _ 207| "Please check and reinstall the file from the ZIP file of this Script" & vbNewLine & _ 208| "with version: long(" & CStr(neededLong) & "), or greater.", vbInformation,"Outdated Classfile: " & SCRIPTNAME 209| End If 210| End If 211| End Property 212| 213| Public Property Get ClassUNSET() As Boolean 214| FreeObject(Reg) 215| FreeObject(TargetDB) 216| FreeObject(SourceDB) 217| FreeObject(ImageCategories) 218| FreeObject(cat) 219| FreeObject(iptc) 220| FreeObject(PropSet) 221| FreeObject(PropSetProp) 222| FreeObject(SourceImgPropRec) 223| FreeObject(TargetImgPropRec) 224| FreeObject(TargetPropSet) 225| FreeObject(TargetPropRec) 226| bSuppressClassNotReadyMsg = False 227| bClassReady = False 228| bDebugging = False 229| ClassUNSET = True 230| End Property 231| 232| 233| 234| 235| Public Property Get ClassInit(Optional ByRef RegCls As clsRegKey, Optional ByRef aSourceDB As Database, Optional ByRef aTargetDB As Database, Optional ByRef SuppressClsNotReadyMsg As Boolean, Optional ByRef DoDebug As Boolean) As Integer 236| 237| On Error GoTo ErrHandler 238| 239| ClassInit = 0 240| bSuppressClassNotReadyMsg = SuppressClsNotReadyMsg 241| 242| If bClassReady Then 243| ClassInit = 1 244| GoTo Escape 245| End If 246| 247| 248| 249| If aSourceDB Is Nothing Then 250| Set SourceDB = Application.ActiveDatabase 251| Else 252| Set SourceDB = aSourceDB 253| End If 254| If aTargetDB Is Nothing Then 255| Set TargetDB = Application.ActiveDatabase 256| Else 257| Set TargetDB = aTargetDB 258| End If 259| If SourceDB Is Nothing Or TargetDB Is Nothing Then 260| ClassInit = 0 261| If Not bSuppressClassNotReadyMsg Then 262| MsgBox "Couldn't initialize the TransmissionClass!" & vbNewLine & vbNewLine & "Have no valid Databases." & vbNewLine & "StandAlone_" & SCRIPTNAME, vbInformation, "(" & SCRIPTNAME & ") stops now!" 263| End If 264| Exit Property 265| End If 266| 267| 268| If RegCls Is Nothing Then 269| Set Reg = New clsRegKey 270| If Reg.ClassInit("StandAlone_" & SCRIPTNAME) = 0 Then 271| ClassInit = 0 272| If Not bSuppressClassNotReadyMsg Then 273| MsgBox "Couldn't initialize the RegKeyClass!" & vbNewLine & "StandAlone_" & SCRIPTNAME, vbInformation, "(" & SCRIPTNAME & ") stops now!" 274| End If 275| Exit Property 276| End If 277| Else 278| Set Reg = RegCls 279| End If 280| 281| 282| 'On success 283| bDebugging = DoDebug 284| bClassReady = True 285| ClassInit = -1 286| 287| 'Without success 288| 'bClassReady = False 289| 'ClassInit = 0 290| 'If Not bSuppressClassNotReadyMsg Then 291| ' MsgBox "You cannot use this Class (" & SCRIPTNAME & ")!" & vbNewLine & vbNewLine & _ 292| ' "Reason:" & vbNewLine & "Descriptiontext", vbInformation, "WorkflowClass isn't already installed or initialized" 293| 'End If 294| 295| Escape: 296| Exit Property 297| 298| ErrHandler: 299| ErrMsg(Err) 300| Resume Escape 301| 302| End Property 303| 304| 305| Public Property Get TransmitIPTC(ByRef SourceImage As Image, ByRef TargetImage As Image) As Boolean 306| 307| On Error GoTo ErrHandler 308| 309| 310| If (TargetImage Is Nothing) Or (TargetImage.IsOnline = False) Or _ 311| (SourceImage Is Nothing) Or (SourceImage.IsOnline = False) Then GoTo Escape 312| 313| 314| 'This variable holds results from IPTC stream 315| Dim res As IMIPTCResults 316| 317| Set iptc = New IPTCStream 318| 319| ' Read the IPTC information from the file. This way we 320| ' know its accessible and has a supported format 321| res = iptc.ReadFile(SourceImage.FileName) 322| 323| ' If we're successful (may also mean that there currently is no IPTC info) 324| If res = imiptcSuccess Or res = imiptcNoIPTCInfo Then 325| 326| If bDebugging Then Debug.Print "Copy IPTC-Stream (fields collected: " & iptc.Fields.Count & ")" & vbNewLine & " Source: " & SourceImage.FileName & vbNewLine & " Target: " & TargetImage.FileName 327| 328| iptc.KeepFileDateTime = True 329| 330| res = iptc.WriteFile(TargetImage.FileName) 331| ' Check the result 332| If res <> imiptcSuccess Then 333| Debug.Print " ERROR updating file (" & TargetImage.FileName & "): ";res 334| End If 335| Else 336| Debug.Print "Error reading ";SourceImage.FileName 337| End If 338| 339| 340| TransmitIPTC = True 341| 342| Escape: 343| FreeObject(iptc) 344| Exit Property 345| 346| ErrHandler: 347| ErrMsg(Err) 348| Resume Escape 349| 350| End Property 351| 352| 353| 354| 355| Public Property Get TransmitCategories(ByRef SourceImage As Image, ByRef TargetImage As Image) As Boolean 356| 357| On Error GoTo ErrHandler 358| 359| 360| If (TargetImage Is Nothing) Or (SourceImage Is Nothing) Then GoTo Escape 361| 362| 'This part was taken from a IMatchScript: 363| 'CreateWorkingCopy - a script by Peter Poorman and Alan Gant 364| 'Copyright 2002 by Peter Poorman 365| 366| ' Propagate categories to the new image 367| ' (Actually, assign the new image to the categories...) 368| 369| Set ImageCategories = SourceImage.Categories 370| If bDebugging Then Debug.Print ImageCategories.Count 371| If ImageCategories.Count <> 0 Then 372| For Each cat In ImageCategories 373| If bDebugging Then Debug.Print "Category: " & cat.FullName 374| TargetDB.Categories(CStr(cat.FullName)).AddImage(TargetImage) 375| Next cat 376| Else 377| If bDebugging Then Debug.Print "No categories assigned to " & SourceImage.Name 378| End If 379| 380| TransmitCategories = True 381| 382| Escape: 383| FreeObject(ImageCategories) 384| FreeObject(cat) 385| Exit Property 386| 387| ErrHandler: 388| ErrMsg(Err) 389| Resume Escape 390| 391| End Property 392| 393| 394| 395| 396| Public Property Get TransmitProperties(ByRef SourceImage As Image, ByRef TargetImage As Image) As Boolean 397| 398| On Error GoTo ErrHandler 399| 400| If (TargetImage Is Nothing) Or (SourceImage Is Nothing) Then GoTo Escape 401| 402| 'This part was taken from a IMatch-UserScript: 403| 'CreateWorkingCopy - a script by Peter Poorman and Alan Gant 404| 'Copyright 2002 by Peter Poorman 405| 406| Set SourceImgPropRec = SourceImage.Properties 407| Set TargetImgPropRec = TargetImage.Properties 408| Set PropSet = SourceDB.PropertySets("Image") 409| 410| For j = 1 To PropSet.Properties.Count 411| Set PropSetProp = PropSet.Properties(j) 412| If PropSetProp.Type = imptReference Then 413| 414| If bDebugging Then 415| Debug.Print "/" & PropSetProp.Name & "/ is a reference to the" 416| Debug.Print " /" & PropSetProp.ReferenceProperty.Name & "/ property of the" 417| Debug.Print " /" & PropSetProp.Reference.Name & "/ property set with a value of" 418| Debug.Print " /" & SourceImgPropRec.Property(PropSetProp.Name) & "/" 419| End If 420| 421| Set TargetPropSet = PropSetProp.Reference 422| For k = 1 To TargetPropSet.Records.Count 423| Set TargetPropRec = TargetPropSet.Records(k) 424| 'Debug.Print "Comparing against /" & TargetPropRec.Property(PropSetProp.ReferenceProperty.Name) & "/" 425| If TargetPropRec.Property(PropSetProp.ReferenceProperty.Name) = SourceImgPropRec.Property(PropSetProp.Name) Then 426| If bDebugging Then 427| Debug.Print "**** Found matching property record at index " & k & ", OID " & TargetPropRec.OID 428| Debug.Print "**** Setting reference property " & PropSetProp.Name & " to " & TargetPropRec.OID & "." 429| End If 430| variantK = k 431| TargetImgPropRec.Property(PropSetProp.Name) = TargetPropRec.OID 432| ' ***********************************************************************************************************' 433| GoTo FoundIt 434| End If 435| Next k 436| 'This isn't actually an error... It just means that the reference property wasn't set 437| 'There are probably better ways to detect this... 438| 'MsgBox "Could not find reference property", vbOkOnly, "Script internal error" 439| 'Exit Sub 440| FoundIt: 441| Else 442| If bDebugging Then Debug.Print "/" & PropSetProp.Name & "/ is not a reference property" 443| TargetImgPropRec.Property(PropSetProp.Name) = SourceImgPropRec.Property(PropSetProp.Name) 444| End If 445| Next j 446| 447| TargetImgPropRec.Update 448| 449| TransmitProperties = True 450| 451| Escape: 452| FreeObject(SourceImgPropRec) 453| FreeObject(TargetImgPropRec) 454| FreeObject(PropSet) 455| FreeObject(PropSetProp) 456| FreeObject(TargetPropSet) 457| FreeObject(TargetPropRec) 458| Exit Property 459| 460| ErrHandler: 461| ErrMsg(Err) 462| Resume Escape 463| 464| End Property 465| 466| Public Property Get TheDialog() As Boolean 467| 468| On Error GoTo ErrHandler 469| 470| If bClassReady Then 471| GoTo PROCESS 472| Else 473| MsgBox "TransmissionClass isn't initialized!" & vbNewLine & "Cannot open the Dialog.",vbInformation,"Please initialise the ClassInstance first" 474| Exit Property 475| End If 476| 477| 478| PROCESS: 479| 480| Begin Dialog UserDialog 290,301,TEXTPHRASE_000 ' %GRID:10,7,1,1 481| GroupBox 40,175,210,49,"",.GroupPSautoAssign 482| GroupBox 40,49,210,112,"Transmissions",.GroupTrans 483| CheckBox 50,196,190,14,TEXTPHRASE_006,.PSautoAssign 484| CheckBox 50,77,180,14,TEXTPHRASE_007,.transProp 485| CheckBox 50,98,180,14,TEXTPHRASE_008,.transCat 486| CheckBox 50,119,180,14,TEXTPHRASE_013,.transIPTC 487| CheckBox 50,140,180,14,TEXTPHRASE_014,.transEXIF 488| OKButton 40,266,210,21,.OK 489| CancelButton 40,238,210,21,.CANCEL 490| Text 10,7,270,35,"Text1",.Text1 491| End Dialog 492| 493| Dim dlg As UserDialog 494| 495| With dlg 496| .PSautoAssign = Reg.GetKey("PSautoAssign",False) 497| .transProp = Reg.GetKey("transProp",False) 498| .transCat = Reg.GetKey("transCat",False) 499| .transIPTC = Reg.GetKey("transIPTC",False) 500| .transEXIF = Reg.GetKey("transEXIF",False) 501| End With 502| 503| 504| Select Case Dialog(dlg) 505| 506| Case -1 507| 508| Reg.SaveKey("PSautoAssign",dlg.PSautoAssign,AsBoolean) 509| Reg.SaveKey("transProp",dlg.transProp,AsBoolean) 510| Reg.SaveKey("transCat",dlg.transCat,AsBoolean) 511| Reg.SaveKey("transIPTC",dlg.transIPTC,AsBoolean) 512| Reg.SaveKey("transEXIF",dlg.transEXIF,AsBoolean) 513| 514| 'Case Else 515| 516| End Select 517| 518| Escape: 519| Exit Property 520| 521| ErrHandler: 522| ErrMsg(Err) 523| Resume Escape 524| 525| End Property 526| 527| Public Property Get TransmitAllSelected(ByRef SourceImage As Image, ByRef TargetImage As Image) As Boolean 528| 529| On Error GoTo ErrHandler 530| 531| If bClassReady Then 532| GoTo PROCESS 533| Else 534| MsgBox "TransmissionClass isn't initialized!" & vbNewLine & "Cannot open the Dialog.",vbInformation,"Please initialise the ClassInstance first" 535| Exit Property 536| End If 537| 538| 539| PROCESS: 540| 541| If (TargetImage Is Nothing) Or (SourceImage Is Nothing) Then GoTo Escape 542| 543| If Reg.GetKey("transProp") Then 544| If bDebugging Then Debug.Print "Transmit Properties" 545| TransmitProperties(SourceImage, TargetImage) 546| End If 547| If Reg.GetKey("transCat") Then 548| If bDebugging Then Debug.Print "Transmit Categories" 549| TransmitCategories(SourceImage, TargetImage) 550| End If 551| If Reg.GetKey("transIPTC") Then 552| If bDebugging Then Debug.Print "Transmit IPTC" 553| TransmitIPTC(SourceImage, TargetImage) 554| End If 555| If Reg.GetKey("transEXIF") Then 556| 'If bDebugging Then Debug.Print "Transmit EXIF" 557| 'Trans.TransmitEXIF(SourceImage, TargetImage) 558| End If 559| 560| TransmitAllSelected = True 561| 562| Escape: 563| Exit Property 564| 565| ErrHandler: 566| ErrMsg(Err) 567| Resume Escape 568| 569| End Property 570| 571| Public Property Get DisplaySelectedTransmissions() As String 572| 573| On Error GoTo ErrHandler 574| 575| If bClassReady Then 576| GoTo PROCESS 577| Else 578| If ClassInit(Reg, SourceDB, TargetDB, True, False) <> 0 Then 579| GoTo PROCESS 580| End If 581| Exit Property 582| End If 583| 584| PROCESS: 585| 586| Dim s As String 587| 588| If Reg.GetKey("transProp") Then s = " - Properties" & vbNewLine 589| If Reg.GetKey("transCat") Then s = s & " - Categories" & vbNewLine 590| If Reg.GetKey("transIPTC") Then s = s & " - IPTC" & vbNewLine 591| If Reg.GetKey("transEXIF") Then s = s & " - Exif" & vbNewLine 592| 593| If s = "" Then 594| s = "No Transmissions" & vbNewLine & "are selected!" 595| Else 596| s = "selected Transmissions:" & vbNewLine & s 597| End If 598| 599| DisplaySelectedTransmissions = s 600| 601| Escape: 602| Exit Property 603| 604| ErrHandler: 605| ErrMsg(Err) 606| Resume Escape 607| 608| End Property 609| 610| 611| 612| 613| '### FunctionList: 614| ' - Public Property Get CheckVersionAgainst(ByRef neededLong As Long, Optional ByRef suppressMsgBox As Boolean = False) As Boolean 615| ' - Public Property Get ClassInit(Optional ByRef RegCls As clsRegKey, Optional ByRef aSourceDB As Database, Optional ByRef aTargetDB As Database, Optional ByRef SuppressClsNotReadyMsg As Boolean, Optional ByRef DoDebug As Boolean) As Integer 616| ' - Public Property Get ClassUNSET() As Boolean 617| ' - Public Property Get ClsName() As String 618| ' - Public Property Get ClsVersion() As Long 619| ' - Public Property Get ClsVersionString() As String 620| ' - Public Property Get DisplaySelectedTransmissions() As String 621| ' - Public Property Get TheDialog() As Boolean 622| ' - Public Property Get TransmitAllSelected(ByRef SourceImage As Image, ByRef TargetImage As Image) As Boolean 623| ' - Public Property Get TransmitCategories(ByRef SourceImage As Image, ByRef TargetImage As Image) As Boolean 624| ' - Public Property Get TransmitIPTC(ByRef SourceImage As Image, ByRef TargetImage As Image) As Boolean 625| ' - Public Property Get TransmitProperties(ByRef SourceImage As Image, ByRef TargetImage As Image) As Boolean 626| 627| '### Public Declarations: 628|