none
Problems about naming of photos using VBA RRS feed

  • Question

  • I have previosly asked a question about rename and extract file in excel file by saving the excel as html to get the folder of the phot and use VBA to rename them and copy them in a new folder.

    However, the copying code only works good when the phot and the code is in the same order. But the problem is there is blank space between the photo.

    For example, there is  4 Photo and 6 codes

    Photo    Code

    photo      123

                   456

    photo       1245

    photo       45487

                   5648

    photo     4564644

    Using my code, the 1st photo will name as 123, but the second one will named as 456 which is wrong.

    So now what I am planing to do is that I can name the photo atuamatically so that I can use vlook up to filt the code without pictures.

    Is there any code that I can name the photo itself automatically???Please help, thank you os much.

    For reference ,here is the code I use to rename file.

    Option Explicit
    Sub Create()
    Application.ScreenUpdating = False
    
       Dim lRow As Integer
       Dim x As Integer
       Dim wbName As String
       Dim fso        As Variant
       Dim dic        As Variant
       Dim OpCoCode       As String
       Dim PhotoName       As String
       Dim OpcoItemCode As String
       Dim VendorItemCode As String
       Dim colSep     As String
       Dim copyFile   As String
       Dim copyTo     As String
       Dim PathFile   As String
       Dim Sheet1 As String
       Dim Sheet2 As String
       Dim Sheet3 As String
       Dim Pass As String
       Dim wb As Workbook
    
    
        
       
       
       Set dic = CreateObject("Scripting.Dictionary") 'dictionary to ensure that duplicates are not created
       Set fso = CreateObject("Scripting.FileSystemObject") 'file scripting object for fiile system manipulation
       
       colSep = "_" 'separater between values of col A and col B for file name
       dic.Add colSep, vbNullString ' ensuring that we never create a file when both columns are blank in between
       
       'get last used row in col A
       lRow = Range("A" & Rows.Count).End(xlUp).Row
       
       x = 1
       PathFile = "C:\Users\wongja\Desktop\ProductCatalog_Kitchen2015_files\"
       copyTo = "C:\Users\wongja\Documents\Photo\" 'location where copied files need to be copied
       
       Do
        x = x + 1
        
        OpCoCode = Range("A" & x).Value 'col a value
        
        PhotoName = Range("B" & x).Value ' col b value
        PhotoName = PhotoName & ".png"
        copyFile = PathFile & PhotoName
        
        
        
        If (Not dic.Exists(PhotoName)) Then 'ensure that we have not created this file name before
          fso.copyFile copyFile, copyTo & OpCoCode & ".jpg" 'copy the file
          dic.Add PhotoName, vbNullString 'add to dictionary that we have created this file
       End If
       
       
        
            
          
       
    Loop Until x = lRow
    
    Set dic = Nothing ' clean up
    Set fso = Nothing ' clean up
    
    Application.ScreenUpdating = True
    
    End Sub

    
    Thursday, December 10, 2015 6:26 AM

Answers

  • >>>But the problem is there is blank space between the photo.

    According to your description, I suggest that you could modify your code like below:

    Do
       
         x = x + 1
         
         If Range("A" & x).Value <> "" Then
            OpCoCode = Range("A" & x).Value 'col a value
            
            PhotoName = Range("B" & x).Value ' col b value
            PhotoName = PhotoName & ".png"
            copyFile = PathFile & PhotoName
            
            If (Not dic.Exists(PhotoName)) Then 'ensure that we have not created this file name before
              fso.copyFile copyFile, copyTo & OpCoCode & ".jpg" 'copy the file
              dic.Add PhotoName, vbNullString 'add to dictionary that we have created this file
            End If
         End If
       
       Loop Until x = lRow

    • Marked as answer by David_JunFeng Wednesday, December 23, 2015 2:36 PM
    Friday, December 11, 2015 5:48 AM