elmnas
04-15-2015, 07:47 AM
Hi guys I have a code that filter a filename then try to open a file
Sub MergeNoTransAndLang()
Dim myPath As String
Dim StrCurrentfile As String
Dim StrFName As String
Dim myLangFile As String
Dim intResult As Integer
Application.DisplayAlerts = True
intResult = Application.FileDialog(msoFileDialogFolderPicker).Show
If intResult = 0 Then
MsgBox "User pressed cancel macro will stop!"
Exit Sub
Else
strDocPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
End If
StrCurrentfile = Dir(strDocPath & "*NoTrans.xls")
Do While StrCurrentfile <> ""
myNoTransfile = strDocPath & StrCurrentfile
myLangFile = Replace(StrCurrentfile, "_NoTrans", "")
MsgBox myLangFile
Set myLangFileN = Workbooks.Open(strDocPath & StrCurrentfile)
Columns(1).Select
Selection.Copy
Set noLangFilen = Workbooks.Open(strDocPath & myLangFile)
noLangFilen.Sheets.Add(After:=noLangFilen.Sheets(noLangFilen.Sheets.Count)) .Name = "WordNotTrans"
ActiveSheet.Paste
ActiveWorkbook.Worksheets("Translated").Activate
Rows("1:1").Select
Selection.EntireRow.Hidden = False
ActiveWorkbook.Worksheets("WordNotTrans").Activate
Dim s As String
Dim Current As Worksheet
For Each Current In Worksheets
For Each C In ActiveSheet.UsedRange
If C.Interior.ColorIndex = 3 Then
s = C.Address
C.Copy Sheets("Translated").Range(s)
End If
Next
Next
Worksheets("WordNotTrans").Delete
Application.DisplayAlerts = False
myLangFileN.Close SaveChanges:=False
noLangFilen.CheckCompatibility = False
noLangFilen.Close SaveChanges:=True
StrCurrentfile = Dir
Loop
End Sub
I get this error
13178
13179
the file exists and have exact that name.
Could someone help me?
Thank you in advance
Sub MergeNoTransAndLang()
Dim myPath As String
Dim StrCurrentfile As String
Dim StrFName As String
Dim myLangFile As String
Dim intResult As Integer
Application.DisplayAlerts = True
intResult = Application.FileDialog(msoFileDialogFolderPicker).Show
If intResult = 0 Then
MsgBox "User pressed cancel macro will stop!"
Exit Sub
Else
strDocPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
End If
StrCurrentfile = Dir(strDocPath & "*NoTrans.xls")
Do While StrCurrentfile <> ""
myNoTransfile = strDocPath & StrCurrentfile
myLangFile = Replace(StrCurrentfile, "_NoTrans", "")
MsgBox myLangFile
Set myLangFileN = Workbooks.Open(strDocPath & StrCurrentfile)
Columns(1).Select
Selection.Copy
Set noLangFilen = Workbooks.Open(strDocPath & myLangFile)
noLangFilen.Sheets.Add(After:=noLangFilen.Sheets(noLangFilen.Sheets.Count)) .Name = "WordNotTrans"
ActiveSheet.Paste
ActiveWorkbook.Worksheets("Translated").Activate
Rows("1:1").Select
Selection.EntireRow.Hidden = False
ActiveWorkbook.Worksheets("WordNotTrans").Activate
Dim s As String
Dim Current As Worksheet
For Each Current In Worksheets
For Each C In ActiveSheet.UsedRange
If C.Interior.ColorIndex = 3 Then
s = C.Address
C.Copy Sheets("Translated").Range(s)
End If
Next
Next
Worksheets("WordNotTrans").Delete
Application.DisplayAlerts = False
myLangFileN.Close SaveChanges:=False
noLangFilen.CheckCompatibility = False
noLangFilen.Close SaveChanges:=True
StrCurrentfile = Dir
Loop
End Sub
I get this error
13178
13179
the file exists and have exact that name.
Could someone help me?
Thank you in advance