Solved

Re-Name .Jpg with one click... ( photo 01, photo 02...)

Posted on 2003-11-02
5
321 Views
Last Modified: 2010-05-01
How can i re-name my photos atomatcly, whit one click...

I get his code...

Dim i As Integer
Dim strNomeNovo As String
Dim strNomeAntigo As String
With Application.FileSerch
 .NewSearch
 .LookIn = Text2.Text
 .SearchSubFolders = Text3.Text
 .FileName = ".jpg"

 If .Execute() > 0 Then
 For i = 1 To .FoundFiles.Count
 strNomeAntigo = .FoundFiles(i)
 strNomeNovo = .LookIn & "\" & Text1.Text & Format$(i, "000#") & ".jpg"
 Name strNomeAntigo As strNomeNovo
   Next i
   MsgBox "Arquivos renomeados com sucesso."
   Else
      MsgBox "Nenhum arquivo .jpg localizado."


 End If
End With
End Sub



BUT, my VB6.0 not like this line of code (With Application.FileSerch)

HELP ME PLEASE!!!!!!!!
0
Comment
Question by:Gehr
  • 4
5 Comments
 
LVL 24

Expert Comment

by:R_Rajesh
ID: 9665720
try this, renames all jpeg files in c:\temp to photo0001, photo0002....

---------------------
Sub asdf()
Dim i As Integer
Dim strNomeNovo As String
Dim strNomeAntigo As String
With Application.FileSearch
    .NewSearch
    .LookIn = "C:\temp"
    .SearchSubFolders = False
    .Filename = "*.jpg"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
strNomeAntigo = .FoundFiles(i)
strNomeNovo = "c:\temp\Photo" & Format$(i, "000#") & ".jpg"
Name strNomeAntigo As strNomeNovo
Next i
MsgBox "Arquivos renomeados com sucesso."
Else
MsgBox "Nenhum arquivo .jpg localizado."
End If
End With
End Sub
--------------
0
 
LVL 24

Expert Comment

by:R_Rajesh
ID: 9665727
actyally your code seems to work fine on my system, so whats the problem??
0
 
LVL 24

Accepted Solution

by:
R_Rajesh earned 125 total points
ID: 9665758
oh sorry, i tried the code in excel. I did not see the last line of your comment, the code works fine on vba if you want to use the same code on vb you have to create an excel or word object in vb (set xl = createobject("excel.application") and then you can use xl.filesearch in vb (at least i think so, dont have access to a system with vb right now)
0
 
LVL 17

Expert Comment

by:zzzzzooc
ID: 9665784
Perhaps something such as the below:

Private Sub Form_Load()
    Dim sPath As String, iCount As Integer, sFile As String
    sPath = "c:\tmp\"
    sFile = Dir(sPath, vbNormal)
    Do Until sFile = ""
        If LCase(Right(sFile, 3)) = "jpg" Then
             Name sPath & sFile As sPath & Format(iCount, "000#") & ".jpg"
        End If
        sFile = Dir()
        iCount = iCount + 1
        DoEvents
    Loop
End Sub
0
 
LVL 24

Expert Comment

by:R_Rajesh
ID: 9665847
Gehr:

use this to search current directory and all sub directories

----------------
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function
Function FindFilesAPI(path As String, SearchStr As String, FileCount As Integer, DirCount As Integer)
Dim FileName As String
Dim DirName As String
Dim dirNames() As String
Dim nDir As Integer
Dim i As Integer
Dim hSearch As Long
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
If Right(path, 1) <> "\" Then path = path & "\"
nDir = 0
ReDim dirNames(nDir)
Cont = True
hSearch = FindFirstFile(path & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
DirName = StripNulls(WFD.cFileName)
If (DirName <> ".") And (DirName <> "..") Then
If GetFileAttributes(path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
dirNames(nDir) = DirName
DirCount = DirCount + 1
nDir = nDir + 1
ReDim Preserve dirNames(nDir)
End If
End If
Cont = FindNextFile(hSearch, WFD)
Loop
Cont = FindClose(hSearch)
End If
hSearch = FindFirstFile(path & SearchStr, WFD)
Cont = True
If hSearch <> INVALID_HANDLE_VALUE Then
While Cont
FileName = StripNulls(WFD.cFileName)
If (FileName <> ".") And (FileName <> "..") Then
FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow
FileCount = FileCount + 1
'use this maintains directory structure
'Name path & FileName As path & "Photo" & Format$(FileCount, "#000") & ".jpg"
'use this to put every thing to root of search path
Name path & FileName As "c:\temp\Photo" & Format$(FileCount, "#000") & ".jpg"

End If
Cont = FindNextFile(hSearch, WFD)
Wend
Cont = FindClose(hSearch)
End If
If nDir > 0 Then
For i = 0 To nDir - 1
FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) & "\", SearchStr, FileCount, DirCount)
Next i
End If
End Function
Private Sub Form_Load()
Dim SearchPath As String, FindStr As String
Dim FileSize As Long
Dim NumFiles As Integer, NumDirs As Integer
SearchPath = "c:\temp"
FindStr = "*.jpg"
FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)
End Sub
-------------------
0

Featured Post

Live: Real-Time Solutions, Start Here

Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

776 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question