none
need help sorry

    Question

  • ok so script 1 allows my to flip images specified in a folder

     

      ' set up objects for files and images
    Set imgFile = CreateObject("WIA.ImageFile")
    Set imgFilter = CreateObject("WIA.ImageProcess")
        ' set up image filter - in this case rotate by 180
    imgFilter.Filters.Add imgFilter.FilterInfos("RotateFlip").FilterID
    imgFilter.Filters(1).Properties("RotationAngle") = 180
    
       ' call the rotation 
    RotatePic "c:\scripts\test1.tiff
    
    
    Sub RotatePic(strFileName)
        ' load the TIFF file
    imgFile.LoadFile strFileName
        ' apply the rotation filter
    Set imgFile = imgFilter.Apply(imgFile)
        ' get a temp file name
    strTempName = objFSO.GetTempName 
        ' save the rotated image to the temp file
    imgFile.SaveFile strTempName
        ' delete the original
    objFSO.DeleteFile strFileName
        ' rename the temp file to the original
    objFSO.MoveFile strTempName, strFileName
    End Sub

     

    and script 2 allows me to find even numbered files in a folder

     

    Dim objFSO
    Dim FolderName
    Dim objDir
    Dim FileDataShort
    Dim FileData
    Dim iFile
    Dim FileList
    Dim nResult
    
    FolderName = "C:\scripts"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objDir = objFSO.GetFolder(FolderName)
    
    For Each iFile in ObjDir.Files
     FileData = objFSO.GetFileName(iFile)
     FileDataShort = left(FileData, len(FileData) -4)
     
     If Isnumeric(FileDataShort) then
      nResult = FileDataShort / 2
       If nResult = Int(nResult) then
        FileList = FileData & vbCrLf & FileList
       End If
     End If 
    Next
    
    Msgbox FileList
    
    Set objFSO = Nothing
    Set objDir = Nothing

     

     

    i need to piece these two together so that script 1 will flip images from the FileList created from script 2. also, script 2 only reads filenames with integers. the file names are "abc000123" i need it to read the last 4 numbers in the filename to check and see if it is an even numbered file instead of the whole filename being an integer.

    Monday, April 12, 2010 6:10 PM

Answers

  • Here you go. I only changed the script to look for the last 4 numbers. The script divides the last 4 numbers by 2, if it divides evenly then it is a "even" number. then it adds the numbers and comma(",") into a variable labeled "FileList". Then the script Splits "FileList" at the comma and then charges a variable named "FlipList". This should contain all of the "even" file paths. The script loops through the "FlipList" variable and calls your Sub RotatePic.

    Const FolderName = "C:\scripts"
    Dim objFSO, objDir, FileData, iFile, FileList, FlipList, nResult
    Dim imgFile, imgFilter

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objDir = objFSO.GetFolder(FolderName)
    Set imgFile = CreateObject("WIA.ImageFile")
    Set imgFilter = CreateObject("WIA.ImageProcess")
    imgFilter.Filters.Add imgFilter.FilterInfos("RotateFlip").FilterID
    imgFilter.Filters(1).Properties("RotationAngle") = 180

    For Each iFile in ObjDir.Files
     'Split the filename at the period return the filename (0) then assign FileData the right 4 characters
     FileData = Right(Split(iFile.Name, ".")(0),4)
     If Isnumeric(FileData) then
      nResult = FileData / 2
      If nResult = Int(nResult) then
       FileList = FileList & "," & iFile.Path
      End If
     End If
    Next
    'Add FileList to a one-dimensional array named FlipList
    FlipList = Split(FileList,",")
    'Loop through FlipList and call Sub RotatePic
    For i = 1 To UBound(FlipList)
     'MsgBox FlipList(i)
     Call RotatePic(FlipList(i))
    Next

    Sub RotatePic(strFileName)
     imgFile.LoadFile strFileName
     Set imgFile = imgFilter.Apply(imgFile)
     strTempName = objFSO.GetTempName
     imgFile.SaveFile strTempName
     objFSO.DeleteFile strFileName
     objFSO.MoveFile strTempName, strFileName
    End Sub

    Set objFSO = Nothing
    Set objDir = Nothing
    Set imgFile = Nothing
    Set imgFilter = Nothing


    Thanks, LikeToCode...Please click "Mark as Answer" when you get the correct reply to your question.
    • Marked as answer by heppy Monday, April 12, 2010 7:13 PM
    Monday, April 12, 2010 7:07 PM

All replies

  • Here you go. I only changed the script to look for the last 4 numbers. The script divides the last 4 numbers by 2, if it divides evenly then it is a "even" number. then it adds the numbers and comma(",") into a variable labeled "FileList". Then the script Splits "FileList" at the comma and then charges a variable named "FlipList". This should contain all of the "even" file paths. The script loops through the "FlipList" variable and calls your Sub RotatePic.

    Const FolderName = "C:\scripts"
    Dim objFSO, objDir, FileData, iFile, FileList, FlipList, nResult
    Dim imgFile, imgFilter

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objDir = objFSO.GetFolder(FolderName)
    Set imgFile = CreateObject("WIA.ImageFile")
    Set imgFilter = CreateObject("WIA.ImageProcess")
    imgFilter.Filters.Add imgFilter.FilterInfos("RotateFlip").FilterID
    imgFilter.Filters(1).Properties("RotationAngle") = 180

    For Each iFile in ObjDir.Files
     'Split the filename at the period return the filename (0) then assign FileData the right 4 characters
     FileData = Right(Split(iFile.Name, ".")(0),4)
     If Isnumeric(FileData) then
      nResult = FileData / 2
      If nResult = Int(nResult) then
       FileList = FileList & "," & iFile.Path
      End If
     End If
    Next
    'Add FileList to a one-dimensional array named FlipList
    FlipList = Split(FileList,",")
    'Loop through FlipList and call Sub RotatePic
    For i = 1 To UBound(FlipList)
     'MsgBox FlipList(i)
     Call RotatePic(FlipList(i))
    Next

    Sub RotatePic(strFileName)
     imgFile.LoadFile strFileName
     Set imgFile = imgFilter.Apply(imgFile)
     strTempName = objFSO.GetTempName
     imgFile.SaveFile strTempName
     objFSO.DeleteFile strFileName
     objFSO.MoveFile strTempName, strFileName
    End Sub

    Set objFSO = Nothing
    Set objDir = Nothing
    Set imgFile = Nothing
    Set imgFilter = Nothing


    Thanks, LikeToCode...Please click "Mark as Answer" when you get the correct reply to your question.
    • Marked as answer by heppy Monday, April 12, 2010 7:13 PM
    Monday, April 12, 2010 7:07 PM
  • you are the man! thank you very very much. you are a life saver. i haven't touched vbs in a couple years so im real rusty.
    Monday, April 12, 2010 7:14 PM