PDA

View Full Version : [SOLVED] need to open file if file exists then merge



elmnas
03-13-2015, 01:45 AM
Hello all,

I have made following code that loops through each file in a folder I select.

when the loop finds a file contains "*NoTrans.xls"

a filename can be example:

test_en_NoTrans.xls


I have a filter that removes "*NoTrans.xls"

so result:

test_en.xls

I need to to make a function to open the file also merging the file into the file

I looping with
test_en_noTrans.xls

Could someone help me?

See code below:







Sub files()
Application.DisplayAlerts = False


Dim wb As Workbook
Dim MyPath As String
Dim MyFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog


'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)


With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
MyPath = .SelectedItems(1) & "\"
End With


'In Case of Cancel
NextCode:
MyPath = MyPath
If MyPath = "" Then GoTo ResetSettings


'Target File Extension (must include wildcard "*")
myExtension = "*NoTrans.xls"


'Target Path with Ending Extention
MyFile = Dir(MyPath & myExtension)


'Loop through each Excel file in folder
Do While MyFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=MyPath & MyFile)

'gör något


MyFileNoTransOpen = ActiveWorkbook.Name
myActFilePath = Application.ActiveWorkbook.Path


myOpenNoTrans = Left(MyFileNoTransOpen, (InStrRev(MyFileNoTransOpen, ".", -1, vbTextCompare) - 9))






myLangFile = myOpenNoTrans & ".xls"




MsgBox myOpenNoTrans


MsgBox myLangFile


MsgBox myActFilePath



' MsgBox ActiveWorkbook.Name


'Save and Close Workbook
wb.Close savechanges:=True


'Get next file name
MyFile = Dir
Loop


'Message Box when tasks are completed
' MsgBox "Nu är alla celler på Rad 1 Dolda!"


ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


End Sub