I am trying to get the name of a file with a specific extension (tmw)
from several different directories. The problem I am having is that
the program stops working on the second pass with an run time error
76. The paths are valid. I tested them and there is a file with the
extension specified.
Any help is appreciated
Marcelo Rizzo
--------------------------------------------------------------------
' User Input from custom forms
Public sReturnLanguage Value() As String
Public sRetrunClientVa lue As String
--------------------------------------------------------------------
Sub updateMasterMem ory()
' Define variables
Dim Counter As Integer
Dim myTradosExportM emName As String
Dim myTradosExportM em As String
Dim myTradosExportF ile As String
Dim clientName As String
Dim errorReport As String
Dim masterMemPath As String
Dim clientMasterMem Path As String
Dim langToImport As String
Dim retValCounter As Integer
Dim myTradosImportM asterMemName As String
Dim myTradosExportM emPath As String
Dim myDirExportPath As String
Dim FileCount As Long
Dim dctDict As Dictionary
Dim varItem As Variant
Dim myTradosExportM emPathBound() As String
' Select the client to Update
clientName = sRetrunClientVa lue
' Set path to master memory and more specific to the client memory
masterMemPath = "P:\" clientMasterMem Path = masterMemPath & clientName
& "\" If masterMemPath & clientName <> masterMemPath &
Dir(masterMemPa th & clientName, vbDirectory) Then
MkDir clientMasterMem Path
End If
' Cycle thru all of the paths
For Counter = 0 To UBound(sReturnL anguageValue)
' Trim extra spaces
myDirExportPath = Trim(sReturnLan guageValue(Coun ter))
If Right(myDirExpo rtPath, 1) <> "\" Then
myDirExportPath = myDirExportPath & "\"
End If
' Create new dictionary with the memory name in the path
Set dctDict = New Dictionary
' Call recursively, return files into Dictionary object.
If GetFiles(myDirE xportPath, dctDict) Then
' Print items in dictionary.
For Each varItem In dctDict
If Right(varItem, 4) = ".tmw" Then
myTradosExportM emName = varItem
FileCount = FileCount + 1
End If
Next
End If
If FileCount > 1 Then
errorReport = "Too many memories in folder: " & vbLf & "
" & myDirExportPath & vbLf & _
"Using only: " & myTradosExportM emName & vbLf
End If
myTradosExportM emPathBound = Split(myTradosE xportMemName, "\")
myTradosExportM emPath =
myTradosExportM emPathBound(UBo und(myTradosExp ortMemPathBound ))
myTradosExportM em = Left(myTradosEx portMemName,
(Len(myTradosEx portMemName) - 4))
langToImport = getlanguage(myT radosExportMemP ath)
If langToImport = "False" Then
errorReport = "Could not Open: " & vbLf & " " &
myDirExportPath & vbLf
Else
myTradosImportM asterMemName = clientMasterMem Path &
langToImport & _
"\" & Dir(clientMaste rMemPath &
langToImport & "\*.tmw")
myTradosExportF ile = myDirExportPath & "\" & myTradosExportM em
& ".txt"
' export the memory
retVal = exportTradosMem (myTradosExport MemPath)
If retVal = "False" Then
' if the export fails paint the line red and continue to
the next memeory
errorReport = errorReport & "Could not Export: " & vbLf &
" " & myDirExportPath & vbLf
retVal = ""
Else
' Check to see if the master memory exist
If Dir(myTradosImp ortMasterMemNam e & "*.tmw") = "" Then
' check to see if the language and/or client directory
of the master memory exist
If Dir(myTradosImp ortMasterMemNam e, vbDirectory) = ""
Then
' if not create a language directory
MkDir myTradosImportM asterMemName
End If
' if not we assume that this is the first memory in
this language
FileCopy myTradosExportM emPath, clientMasterMem Path &
langToImport & _
"\" & clientName & "_" &
LCase(getCountr yCode(langToImp ort)) & ".tmw"
Else
' If every jives import the memory
retVal = importTradosMem (myTradosImport MasterMemName,
myTradosExportF ile)
' Just in case something goes wrong
If retVal = "False" Then
errorReport = errorReport & "Could not Inport: " &
vbLf & " " & myDirExportPath & vbLf
retVal = ""
End If
End If
End If
End If
' Reset the variables used in each cycle
myDirExportPath = ""
myTradosExportM emName = ""
myTradosExportM emPath = ""
myTradosExportM em = ""
langToImport = ""
myTradosImportM asterMemName = ""
myTradosExportF ile = ""
retVal = ""
Set fso = Nothing
Set SearchFolder = Nothing
Set objFile = Nothing
' get the next path
Next Counter
MsgBox errorReport, vbCritical, "Error Report"
End Sub
----------------------------------------------------------------------------
------
Private Function GetFiles(strPat h As String, _
dctDict As Dictionary, _
Optional blnRecursive As Boolean) As Boolean
' This procedure returns all the files in a directory into
' a Dictionary object. If called recursively, it also returns
' all files in subfolders.
Dim fsoSysObj As FileSystemObjec t
Dim fdrFolder As Folder
Dim fdrSubFolder As Folder
Dim filFile As File
' Return new FileSystemObjec t.
Set fsoSysObj = New FileSystemObjec t
On Error Resume Next
' Get folder.
Set fdrFolder = fsoSysObj.GetFo lder(strPath)
If Err <> 0 Then
' Incorrect path.
GetFiles = False
GoTo GetFiles_End
End If
On Error GoTo 0
' Loop through Files collection, adding to dictionary.
For Each filFile In fdrFolder.Files
dctDict.Add filFile.Path, filFile.Path
Next filFile
' If Recursive flag is true, call recursively.
If blnRecursive Then
For Each fdrSubFolder In fdrFolder.SubFo lders
GetFiles fdrSubFolder.Pa th, dctDict, True
Next fdrSubFolder
End If
' Return True if no error occurred.
GetFiles = True
GetFiles_End:
Exit Function
End Function
---------------------------------------------------------------
from several different directories. The problem I am having is that
the program stops working on the second pass with an run time error
76. The paths are valid. I tested them and there is a file with the
extension specified.
Any help is appreciated
Marcelo Rizzo
--------------------------------------------------------------------
' User Input from custom forms
Public sReturnLanguage Value() As String
Public sRetrunClientVa lue As String
--------------------------------------------------------------------
Sub updateMasterMem ory()
' Define variables
Dim Counter As Integer
Dim myTradosExportM emName As String
Dim myTradosExportM em As String
Dim myTradosExportF ile As String
Dim clientName As String
Dim errorReport As String
Dim masterMemPath As String
Dim clientMasterMem Path As String
Dim langToImport As String
Dim retValCounter As Integer
Dim myTradosImportM asterMemName As String
Dim myTradosExportM emPath As String
Dim myDirExportPath As String
Dim FileCount As Long
Dim dctDict As Dictionary
Dim varItem As Variant
Dim myTradosExportM emPathBound() As String
' Select the client to Update
clientName = sRetrunClientVa lue
' Set path to master memory and more specific to the client memory
masterMemPath = "P:\" clientMasterMem Path = masterMemPath & clientName
& "\" If masterMemPath & clientName <> masterMemPath &
Dir(masterMemPa th & clientName, vbDirectory) Then
MkDir clientMasterMem Path
End If
' Cycle thru all of the paths
For Counter = 0 To UBound(sReturnL anguageValue)
' Trim extra spaces
myDirExportPath = Trim(sReturnLan guageValue(Coun ter))
If Right(myDirExpo rtPath, 1) <> "\" Then
myDirExportPath = myDirExportPath & "\"
End If
' Create new dictionary with the memory name in the path
Set dctDict = New Dictionary
' Call recursively, return files into Dictionary object.
If GetFiles(myDirE xportPath, dctDict) Then
' Print items in dictionary.
For Each varItem In dctDict
If Right(varItem, 4) = ".tmw" Then
myTradosExportM emName = varItem
FileCount = FileCount + 1
End If
Next
End If
If FileCount > 1 Then
errorReport = "Too many memories in folder: " & vbLf & "
" & myDirExportPath & vbLf & _
"Using only: " & myTradosExportM emName & vbLf
End If
myTradosExportM emPathBound = Split(myTradosE xportMemName, "\")
myTradosExportM emPath =
myTradosExportM emPathBound(UBo und(myTradosExp ortMemPathBound ))
myTradosExportM em = Left(myTradosEx portMemName,
(Len(myTradosEx portMemName) - 4))
langToImport = getlanguage(myT radosExportMemP ath)
If langToImport = "False" Then
errorReport = "Could not Open: " & vbLf & " " &
myDirExportPath & vbLf
Else
myTradosImportM asterMemName = clientMasterMem Path &
langToImport & _
"\" & Dir(clientMaste rMemPath &
langToImport & "\*.tmw")
myTradosExportF ile = myDirExportPath & "\" & myTradosExportM em
& ".txt"
' export the memory
retVal = exportTradosMem (myTradosExport MemPath)
If retVal = "False" Then
' if the export fails paint the line red and continue to
the next memeory
errorReport = errorReport & "Could not Export: " & vbLf &
" " & myDirExportPath & vbLf
retVal = ""
Else
' Check to see if the master memory exist
If Dir(myTradosImp ortMasterMemNam e & "*.tmw") = "" Then
' check to see if the language and/or client directory
of the master memory exist
If Dir(myTradosImp ortMasterMemNam e, vbDirectory) = ""
Then
' if not create a language directory
MkDir myTradosImportM asterMemName
End If
' if not we assume that this is the first memory in
this language
FileCopy myTradosExportM emPath, clientMasterMem Path &
langToImport & _
"\" & clientName & "_" &
LCase(getCountr yCode(langToImp ort)) & ".tmw"
Else
' If every jives import the memory
retVal = importTradosMem (myTradosImport MasterMemName,
myTradosExportF ile)
' Just in case something goes wrong
If retVal = "False" Then
errorReport = errorReport & "Could not Inport: " &
vbLf & " " & myDirExportPath & vbLf
retVal = ""
End If
End If
End If
End If
' Reset the variables used in each cycle
myDirExportPath = ""
myTradosExportM emName = ""
myTradosExportM emPath = ""
myTradosExportM em = ""
langToImport = ""
myTradosImportM asterMemName = ""
myTradosExportF ile = ""
retVal = ""
Set fso = Nothing
Set SearchFolder = Nothing
Set objFile = Nothing
' get the next path
Next Counter
MsgBox errorReport, vbCritical, "Error Report"
End Sub
----------------------------------------------------------------------------
------
Private Function GetFiles(strPat h As String, _
dctDict As Dictionary, _
Optional blnRecursive As Boolean) As Boolean
' This procedure returns all the files in a directory into
' a Dictionary object. If called recursively, it also returns
' all files in subfolders.
Dim fsoSysObj As FileSystemObjec t
Dim fdrFolder As Folder
Dim fdrSubFolder As Folder
Dim filFile As File
' Return new FileSystemObjec t.
Set fsoSysObj = New FileSystemObjec t
On Error Resume Next
' Get folder.
Set fdrFolder = fsoSysObj.GetFo lder(strPath)
If Err <> 0 Then
' Incorrect path.
GetFiles = False
GoTo GetFiles_End
End If
On Error GoTo 0
' Loop through Files collection, adding to dictionary.
For Each filFile In fdrFolder.Files
dctDict.Add filFile.Path, filFile.Path
Next filFile
' If Recursive flag is true, call recursively.
If blnRecursive Then
For Each fdrSubFolder In fdrFolder.SubFo lders
GetFiles fdrSubFolder.Pa th, dctDict, True
Next fdrSubFolder
End If
' Return True if no error occurred.
GetFiles = True
GetFiles_End:
Exit Function
End Function
---------------------------------------------------------------