VBA script to open files based on criterias

[zuklar95]

Hello everyone.
1. I am working with excel 2019
2. What I am asking for help here is with the following:

I need to create a button that opens word documents from a local folder, based on 4 criteria's.
These 4 criteria's are in the name of the files as such Criteria1_Criteria2_criteria3_criteria4 , as per screenshot below
31291

Criteria1 is the called channel, criteria2 is budgettype, criteria3 is reasondescription and criteria4 is partner.

So criteria1 is OPdirect (in blue), criteria2 is mixed ( in yellow), and criteria3 is adit modif conditii ( in red) and criteria4 which is partener ( in green)

When these 4 criterias are selected from a dropdown box, which i already made, i need the button to open the said word document.

I managed to get this far but idk how to go further


Sub Button6_Click()
Sub OpenDocument()
Dim channel As String
Dim budgetType As String
Dim reasonDescription As String
Dim partner As String
Dim filePath As String
channel = Sheets("Sheet1").Range("c4").Value
budgetType = Sheets("Sheet1").Range("h4").Value
reasonDescription = Sheets("Sheet1").Range("m4").Value
partner = Sheets("Sheet1").Range("r4").Value

Thank you in advance.

[Aussiebear]

Welcome to VBAX zuklar95. I noticed from your example of file names that they consist of 5 parts (from the image) not just 4 as you are suggesting in the text. How do you propose to select the first bit "NC##"?

[zuklar95]

Thank you for the response. The first part of the name its irrelevant for what I need. That is just an indicator for myself when i created those files.
I tried something a little different here but it doesnt really work


Dim partner As String
Dim filePath As String
Dim fileName As String
Dim sharedFolderPath As String
FolderPath = "C:\Users\Andrei\Desktop\vba\docs"
With Sheets("Sheet1")
channel = .OLEObjects(c4).Object.Value
budgetType = .OLEObjects(h4).Object.Value
reasonDescription = .OLEObjects(m4).Object.Value
partner = .OLEObjects(r4).Object.Value
End With



fileName = reasonDescription & "_" & channel & "_" & budgetType & "_" & partner & ".docx"

I apologize if my explanations are not too clear, english is not my main language and also i just started reading about vba this week.

[georgiboy]

Perhaps the below will help, there are a couple of ways to interact with Word from Excel, below is one.


Option Explicit

Sub test()
Dim wrdApp As Object, sFold As String, sFile As String
Dim chan As String, bt As String, rd As String, prt As String

chan = Range("C4").Value
bt = Range("H4").Value
rd = Range("M4").Value
prt = Range("R4").Value

sFold = "C:\Users\Andrei\Desktop\vba\docs\"
sFile = Dir(sFold)

Do While Len(sFile) > 0
If InStr(sFile, chan) And InStr(sFile, bt) And InStr(sFile, rd) And InStr(sFile, prt) Then
Set wrdApp = CreateObject("word.Application")
wrdApp.Documents.Open sFold & sFile
wrdApp.Visible = True
Exit Sub
End If
sFile = Dir
Loop
End Sub

[Aussiebear]

Here comes a caveman style.....


Option Explicit

Sub FindCopySaveCSV()
Dim wrdApp As Object,
Dim fPath As String
Dim wb as Workbook
Dim sFile As String
Dim Str1 As String,
Dim Str2 As String,
Dim Str2 As String,
Dim Str4 As String
Set Str1 = Range("C4").Value
Set Str2 = Range("H4").Value
Set Str3 = Range("M4").Value
Set Str4 = Range("R4").Value
fPath = "C:\Users\Andrei\Desktop\vba\docs\"
fFiles = Dir(fPath)
For each wb in fFiles
If InStr(fFile, Str1) &”_” & InStr(fFile, Str2) &”_” & InStr(fFile, Str3) &”_” & InStr(fFile, Str4) Then
Set wrdApp = CreateObject("word.Application")
wrdApp.Documents.Open fPath & fFile
wrdApp.Visible = True
Exit Sub
End If
fFiles= Dir
Loop
End Sub

[zuklar95]

Perhaps the below will help, there are a couple of ways to interact with Word from Excel, below is one.


Option Explicit

Sub test()
Dim wrdApp As Object, sFold As String, sFile As String
Dim chan As String, bt As String, rd As String, prt As String

chan = Range("C4").Value
bt = Range("H4").Value
rd = Range("M4").Value
prt = Range("R4").Value

sFold = "C:\Users\Andrei\Desktop\vba\docs\"
sFile = Dir(sFold)

Do While Len(sFile) > 0
If InStr(sFile, chan) And InStr(sFile, bt) And InStr(sFile, rd) And InStr(sFile, prt) Then
Set wrdApp = CreateObject("word.Application")
wrdApp.Documents.Open sFold & sFile
wrdApp.Visible = True
Exit Sub
End If
sFile = Dir
Loop
End Sub


Thank you for the response.

I tried it and played around with it, but i get the following error message:
31293


I double checked and i have everything enabled for macros, and with other macros i had different errors, with debug option.

[georgiboy]

I can't see the attachment, can you type the error along with the error number?

Can you provide a workbook with how you have it set up currently?

[Aussiebear]

zuklar95, your attachment is invalid. Please try again using the protocols set out within the forum.

On a secondary thought process, what format are these original files saved as?

[zuklar95]

Thank you for the code Aussiebear! I tried it but now i get a different error, saying Invalid outside procedure when i try to run yours on a new button.
The excel i am working on is .xlsm and the files i need opened are .docx

Georgiboy, the previous error message was as follows: Cannot run the macro. The macro may not be available in this workbook or all macros may be disabled.

I have attached the workbook excel here
31296

[georgiboy]

One issue you had in there was that you had two macro's with the same name. This can't happen as you will get an error. Try the attached file.

[zuklar95]

Thank you for getting back to me with the solution.
I tried it and indeed now i do not receive any error message, but nothing happens when pressing the button.
I followed your note and changed the name of one of the documents, to test it out. I precisely looked for it.
31298

I was wondering if maybe there might some other issue, so I tried to add and to your code the following
else
msgbox "file not found"

just to let me know that it is actually looking, but didn't get that error either.

This is the name in question if you could try it on your end: (OP-d)_Variable (V)_Modificare cond contract_no partener

[zuklar95]

I also played around with the previous try



Sub OpenDocument() Dim channel As String
Dim budgetType As String
Dim reasonDescription As String
Dim partner As String
Dim filePath As String
Dim fileName As String
Dim FolderPath As String


FolderPath = "C:\Users\Andrei\Desktop\vba\docs\"


channel = Sheets("Sheet1").Range("c4").Value
budgetType = Sheets("Sheet1").Range("h4").Value
reasonDescription = Sheets("Sheet1").Range("m4").Value
partner = Sheets("Sheet1").Range("r4").Value


fileName = channel & "_" & reasonDescription & "_" & budgetType & "_" & partner




filePath = FolderPath & fileName


If Dir(filePath) <> "" Then

ThisWorkbook.FollowHyperlink filePath
Else
MsgBox "File not found: " & filePath
End If
End Sub


and here i do get an error message saying that the file could not be found, no matter how i try to change the name, or order.
blow there is the error message attached
31299


edit: Maybe you can see something i cannot see i am missing here. I would like to add that i also tried once to put the extension .docx at the end and it still didn't work. I am wondering if it is related to the underscore line.

[georgiboy]

As we are using 'Exit Sub' after it opens the word file, we should be able to just put the 'not found' message box as below:

Sub test()
Dim wrdApp As Object, sFold As String, sFile As String
Dim chan As String, bt As String, rd As String, prt As String

chan = Range("C4").Value
bt = Range("H4").Value
rd = Range("M4").Value
prt = Range("R4").Value

sFold = "C:\Users\Andrei\Desktop\vba\docs\"
sFile = Dir(sFold)

Do While Len(sFile) > 0
If InStr(sFile, chan) And InStr(sFile, bt) And InStr(sFile, rd) And InStr(sFile, prt) Then
Set wrdApp = CreateObject("word.Application")
wrdApp.Documents.Open sFold & sFile
wrdApp.Visible = True
Exit Sub
End If
sFile = Dir
Loop
MsgBox "file not found"
End Sub

With the below line:

sFold = "C:\Users\Andrei\Desktop\vba\docs\"
Are you including the \ at the end?
Are you sure that the file resides in that folder?

[zuklar95]

Without doing any changes, the script you wrote now works perfectly!
I did check the details on mine and all checks out. I still don't know why its giving me that error.

I will try it a few more times tomorrow on my other laptop on which I need it to run, and it everything works, I will mark the thread as solved.

Thank you for the help and involvement, have a great evening!

[georgiboy]

You are welcome