Prompt to replace file while saving - vba

Below is what I'm trying to do -
Copy data from an existing workbook and paste as text to existing word file saved on local drive
Save that file using predefined text + value defined in excel cell + today's date
It all works fine but only problem I'm facing is, I want it to give me a prompt if file name already exists such that I could take an informed decision whether or not to replace it with existing one. But it doesn't do that. It just overwrites the existing one.
Code
Sub GenerateLabelandInvoice()
'Open an existing Word Document from Excel
Dim objWord As Object
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.Application.DisplayAlerts = True
objWord.Documents.Open "D:\path name \ file name.docx"
Range("L19:L29").Copy
With objWord
.Selection.PasteSpecial DataType:=wdPasteText
objWord.ActiveDocument.SaveAs Filename:="D:\path name\" & _
"Address Label & Invoice - " & Range("L23").Value & " " & _
Format(Date, "dd-mmm-yyyy") & ".docx", _
FileFormat:=wdFormatXMLDocument, AddtoRecentFiles:=False
objWord.Visible = True
objWord.Application.DisplayAlerts = True
End With
End Sub

Save the filename in a variable and then using DIR test if the file exists.
Is this what you are trying? (Untested)
Dim NewFileName As String
Dim Ret As Variant
NewFileName = "D:\path name\" & "Address Label & Invoice - " & _
Range("L23").Value & " " & _
Format(Date, "dd-mmm-yyyy") & ".docx"
If Dir(NewFileName) <> "" Then
Ret = MsgBox("File exists. Would you like to replace", vbOKCancel)
If Ret = vbOK Then
objWord.ActiveDocument.SaveAs Filename:=NewFileName, _
FileFormat:=wdFormatXMLDocument, AddtoRecentFiles:=False
End If
Else
objWord.ActiveDocument.SaveAs Filename:=NewFileName, _
FileFormat:=wdFormatXMLDocument, AddtoRecentFiles:=False
End If

Related

VBA to Create a Folder and Save as a pdf within the folder

i'm very new to VBA and have an issue.
I've received help in saving a file into a specific folder but not allowing me to overwrite the file.
Sub Autosave2()
Dim vDir
Dim strFileExists, pdfname, fileSaveName As String
Dim FSO
pdfname = ActiveSheet.Range("Q2")
vDir = "\\Reports\Internal PO Log\PO pdf's\"
If Right(pdfname, 3) = "pdf" Then
fileSaveName = vDir & pdfname
Else
fileSaveName = vDir & pdfname & ".pdf"
End If
MsgBox fileSaveName
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FileExists(fileSaveName) Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fileSaveName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
MsgBox "PDF File Saved (CentreSoft\Reports\Internal PO Log\PO pdf's)"
Else
MsgBox "THIS PO NUMBER ALREADY EXISTS"
End If
End Sub
I now need to create a folder with the same name (Range("Q2")) and save the file as a pdf within the new folder (with the same name; PO number in this scenario)
I also need to display messages should the folder already exits thus blocking the code from running any further.
Any help would be hugely appreciated
Thanks
Is this what you want?
Sub Autosave2()
Dim vDir
Dim strFileExists, pdfname, fileSaveName As String
Dim separator As String: separator = Application.PathSeparator
Dim FSO
pdfname = ActiveSheet.Range("Q2")
vDir = "\\Reports\Internal PO Log\" & pdfname
If Dir(vDir, vbDirectory) = "" Then
'create folder
MkDir vDir
Else
MsgBox "The folder already exits thus blocking the code from running any further."
Exit Sub
End If
If Right(pdfname, 3) = "pdf" Then
fileSaveName = vDir & separator & pdfname
Else
fileSaveName = vDir & separator & pdfname & ".pdf"
End If
'MsgBox fileSaveName
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FileExists(fileSaveName) Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=fileSaveName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
MsgBox "PDF File Saved in " & vDir
Else
MsgBox "THIS PO NUMBER ALREADY EXISTS"
End If
End Sub
I've solved it :-)
Sub Autosave2()
Dim vDir
Dim strFileExists, pdfname, fileSaveName As String
Dim FSO
Dim FldrName As String
pdfname = ActiveSheet.Range("Q2")
FldrName = "\\Reports\Internal PO Log\PO pdf's\" & pdfname & "\" & pdfname
vDir = "\\Reports\Internal PO Log\PO pdf's\" & pdfname
If Dir(vDir, vbDirectory) = "" Then
'continue
Else
MsgBox "The folder already exits thus blocking the code from running any further."
Exit Sub
End If
'create folder
MkDir vDir
If Right(pdfname, 3) = "pdf" Then
fileSaveName = FldrName & ".pdf"
Else
fileSaveName = FldrName & ".pdf"
End If
'MsgBox fileSaveName
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FileExists(fileSaveName) Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fileSaveName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
MsgBox "PDF File Saved in " & vDir
Else
MsgBox "THIS PO NUMBER ALREADY EXISTS"
End If
End Sub
Not too sure if it's the best work around but i've created a new FldrName and pointed everything towards that in the file save
Thanks so much for getting me that far.....you've been a great help

Word Document created does not convert to PDF

Generated Word Document does not convert to PDF
I generate a Word Document populating the bookmarks within it from excel and then tried exporting to PDF. Constantly getting error even after adding Microsoft Word Library 16.0. What am I doing wrong here?
Option Explicit
Sub GenerateTerminationLetter()
Dim objWord As Object, docWord As Object
Dim wb As Workbook
Dim xlName As Name
Dim Path, SavePath, TempPath, FileName3 As String
Dim EmpFileName As String
Set wb = ThisWorkbook
' ******************************* Primary Letter Template Location ***********************
Sheets("FilePath").Select
TempPath = Sheets("FilePath").Range("C16").Value
If Right(TempPath, 1) <> "\" Then
TempPath = TempPath & "\"
Else
End If
Path = TempPath & "Termination Letter (Redundancy A023 FPP) (NEW - With Whistle Blowing Statement).docx"
'*******************************Populate Bookmarks ***************************************
On Error GoTo ErrorHandler
'Create a new Word Session
Set objWord = CreateObject("Word.Application")
'Open document in word
Set docWord = objWord.Documents.Add(Path)
'Loop through names in the activeworkbook
For Each xlName In wb.Names
'if xlName's name exists in the document then put the value at the bookmark
If docWord.Bookmarks.Exists(xlName.Name) Then
docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName.Value)
End If
Next xlName
Sheets("Temp").Visible = xlVeryHidden
'******************************* Activate word and display document **********************
With objWord
.Visible = True
.Activate
End With
'Save Termination Letter
FileName3 = Sheets("R-Copy").Range("D7").Value
'******************************* Export as PDF ********************************************
docWord.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=EmpFolder & "\" & "Termination Letter_" & FileName3, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
ExportFormat:=wdExportFormatPDF
objWord.Quit
'Release the Word object to save memory and exit macro
ErrorExit:
Set objWord = Nothing
Exit Sub
'Error Handling routine
ErrorHandler:
If Err Then
MsgBox "Error No: " & Err.Number & "; There is a problem. Contact Administrator"
If Not objWord Is Nothing Then objWord.Quit False
Resume ErrorExit
End If
End Sub
Error No. 448: Contact Administrator
Which line is triggering the error? I'm assuming its the exportAsFixedFormat line. Error 448 is Named argument not found, and it looks like Type isn't one of the allowed arguments. You problably want ExportFormat:=wdExportFormatPDF, which it looks like you've included, but Type isn't an allowed argument, and will cause an error. Here's the docs on that method: https://learn.microsoft.com/en-us/office/vba/api/word.document.exportasfixedformat
It looks like some of the other arguments you're using aren't quite right, too, since they're referencing xl instead of wd types and the property names don't quite line up. Try:
docWord.ExportAsFixedFormat _
OutputFileName:=EmpFolder & "\" & "Termination Letter_" & FileName3, _
IncludeDocProps:=True, _
ExportFormat:=wdExportFormatPDF
Also, I don't believe you are setting EmpFolder anywhere, so it's an empty variable, which is probably either going to make the method fail or cause it to save the file in the wrong place.
Let me know if that works for you.
Sub BatchConvertDocxToPDF()
Dim objDoc1, objWord1 As Object
Dim strFile As String, strFolder, fp As String
'Initialization
strFolder = EmpFolder & "\"
strFile = Dir(strFolder & "*.docx", vbNormal)
xp = strFolder & strFile
'Process each file in the file folder and convert them to pdf.
Dim objWord As Object
Dim objDoc As Object
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
While strFile <> ""
Set objDoc1 = objWord.Documents.Open(Filename:=strFolder & strFile)
objDoc1.ExportAsFixedFormat _
OutputFileName:=Replace(objDoc1.FullName, ".docx", ".pdf"), _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False,
OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, Item:=wdExportDocumentContent
objDoc1.Close
strFile = Dir()
Wend
objWord.Visible = False
Set objDoc1 = Nothing
Set objWord = Nothing
End Sub

VBA code to save PDF does not work properly

I have set up a command button to save the current worksheet as a PDF file. I have played around with this code for several hours and almost got it to work properly but it seems I have disconnected some areas and cannot find my way back. Please see below for the code that I am using and the variables I am having an issue with at this point. Any help or information would be much appreciated! Thanks in advance!
Issues:
When you click 'Cancel' in the save application box, the document still tries to save.
If the file already exists:
Selecting 'Yes' to over-write does not save the document.
Selecting 'No' to over-write and renaming as another already existing document does not prompt another Question box to over-write or not. It simply over-writes the original document name.
Sub PDFFHA()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strPath = "I:\OCC FRB REMIC Reporting\Quality Control\PDFs"
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
strName = Replace(wsA.Range("D3"), " ", "")
strName = Replace(strName, ".", "_")
strFile = "FHA" & "_" & strName & "_" & "QC" & ".pdf"
strPathFile = strPath & strFile
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If bFileExists(strPathFile) Then
lOver = MsgBox("Overwrite existing file?", _
vbQuestion + vbYesNo, "File Exists")
If lOver <> vbYes Then
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPathFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "PDF file has been created: " _
& vbCrLf _
& strPathFile
Else
GoTo exitHandler
End If
End If
Else
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPathFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "PDF file has been created: " _
& vbCrLf _
& strPathFile
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
'=============================
Function bFileExists(rsFullPath As String) As Boolean
bFileExists = CBool(Len(Dir$(rsFullPath)) > 0)
End Function
'=============================
With some clean-up and re-formatting.
If the file already exists, you are prompted to overwrite or not. The code only checks for the response to be vbNo since vbYes implies that strPathFile remains the same, i.e. no action needed. The loop handles a Cancel click, as well as the possibility that your new strPathFile is again an existing file.
Option Explicit
Sub PDF_FHA()
Dim wsA As Worksheet: Set wsA = ActiveWorkbook.ActiveSheet
Dim strName, strPath, strFile, strPathFile As String
On Error GoTo errHandler
' Get path
strPath = "I:\OCC FRB REMIC Reporting\Quality Control\PDFs\"
' Get and clean filename
strName = Replace(wsA.Range("D3"), " ", "")
strName = Replace(strName, ".", "_")
strFile = "FHA_" & strName & "_QC.pdf"
strPathFile = strPath & strFile
' Check if file exists, prompt overwrite
If bFileExists(strPathFile) Then
If MsgBox("Overwrite existing file?", _
vbQuestion + vbYesNo, "File Exists") = vbNo Then
Do
strPathFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
' Handle cancel
If strPathFile = "False" Then Exit Sub
' Loop if new filename still exists
Loop While bFileExists(strPathFile)
End If
End If
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPathFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "PDF file has been created: " _
& vbCrLf _
& strPathFile
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
End Sub
'=============================
Function bFileExists(rsFullPath As String) As Boolean
bFileExists = CBool(Len(Dir$(rsFullPath)) > 0)
End Function
'=============================
Firstly, turn Option Explicit on.
Follow the logic in If lOver <> vbYes Then. With the proper indenting you will see that it only handles the <> vbYes path and does not have an Else.
So, you do not actually handle the "Yes" case.
Your "No" logic only brings up a file dialog box and we don't know what you have done to test this (cancel, put new name in, just accept name as presented?). However, there is no additional question on this logic path. If you don't hit "Cancel" to the file dialog it will just save the file.

Excel Workbook to Create Word Document and Auto-Run Mail Merge from Excel Workbook

I've got a bit of a tricky one here. Attempting to simplify an existing process.
Existing Process:
Word Document ("Plan Doc Template") is entirely composed of INCLUDETEXT fields that pull Bookmarked sections from another Word Document ("Source Plan Doc" we'll call it) that includes merge-fields in its bookmarked sections which are from an Excel Workbook ("Mail Merge Workbook").
The current process involves the user copying a Plan Doc Template and a Mail Merge Workbook and pasting it into any folder they choose. The user then fills out the Mail Merge Workbook, saves and closes, and runs a Mail Merge through the Plan Doc Template Word Doc. This pulls in bookmarked sections from the Source Plan Doc depending on the Mail Merge Workbook fields selected. The user then removes all INCLUDETEXT fields with CTRL + SHIFT + F9 to turn fields of Plan Doc Template into workable text.
(Hopeful) Future Process:
The user copies a Mail Merge Workbook and pastes it into their
desired folder. Fills out the Mail Merge Workbook. (Manual Step)
Runs VBA Code.
VBA copies the Plan Doc Template and pastes in the Mail Merge Workbook's folder that just ran the VBA code.
VBA renames the Plan Doc Template Word Doc based on fields within the Mail Merge Workbook.
VBA runs a Mail Merge within the Plan Doc Template
VBA highlights entire document and CTRL + SHIFT + F9 to turn Field Codes into workable text.
Is it possible to do all this from an Excel VBA code or would I need a separate code after the Plan Doc has been created to run the mail merge and do the CTRL + SHIFT + F9 steps?
P.S. I use Excel Worksheets via DDE Selection to get the correct formatting from Mail Merge Workbook to Document. Hoping that can be included in the VBA code, as well.
Help would be greatly appreciated on this one, thanks,
Rich
It looks like you can have the whole thing run with one macro from Excel, without the user having to run a second one, using a For loop until wdApp.Documents.Count increases by 1. I did test the following, but with only a very small data set, so it ran very quickly.
Since the user might have more than just the main merge document open, it's important the code can identify and work with the resulting document. Usually, it will have become the ActiveDocument but relying on that is never certain. So I built in a couple of loops to 1) hold the currently open documents in an array then 2) compare those to the currently active document. If the currently active document is not in the array, then the fields are unlinked (that's the equivalent of Ctrl+Shift+F9).
Of course, if you really wanted to identify the new document from all the documents you'd need to loop each document and loop the array, making the comparison. But I've given you the starting point...
Sub MergeWithWord()
Dim wdApp As Object
Dim wdDoc As Object
Dim nrDocs As Long
Dim i As Long, d As Long
Dim aDocs() As Variant
Set wdApp = GetObject(, "Word.Application")
nrDocs = wdApp.documents.Count
'Get all opened documents so can compare whether a new one
ReDim Preserve aDocs(nrDocs - 1)
Set wdDoc = wdApp.activedocument
For i = 0 To nrDocs - 1
Set aDocs(i) = wdApp.documents(i + 1)
Next
If wdDoc.MailMerge.MainDocumentType <> -1 Then
wdDoc.MailMerge.Destination = 0
wdDoc.MailMerge.Execute False
Do Until wdApp.documents.Count > nrDocs Or i > 1000
i = i + 1
Loop
Set wdDoc = wdApp.activedocument
For d = 0 To UBound(aDocs)
If wdDoc Is aDocs(d) Then
Debug.Print "Not a new doc"
Else
Debug.Print wdDoc.FullName
wdDoc.Fields.Unlink
Exit For
End If
Next
End If
Debug.Print nrDocs, i
MsgBox "Done"
End Sub
May not be the most elegant code but here was what I wound up using to solve my question in case it helps anyone else.
Sub ButtonMerge()
Dim str1 As String
Dim PlanDocTemplate As String
Dim EDrive As String
Dim answer1 As Integer
Dim answer2 As Integer
answer1 = MsgBox("Is this IC Plan Workbook saved in the appropriate Client folder?", vbYesNo + vbQuestion)
If answer1 = vbNo Then
MsgBox ("Please save this IC Plan Workbook in the appropriate Client folder then run again.")
Exit Sub
Else
'do nothing
End If
str1 = "Q:\IC\New Structure\IC Toolkit\Templates\01 Plan Doc Template\16 Source\IC Plan Doc Template v1.0.docx"
PlanDocTemplate = Application.ActiveWorkbook.Path & "\" & Range("A1").Value & ".docx"
EDrive = "E:\" & Range("A1").Value & ".docx"
If Len(Dir(Application.ActiveWorkbook.Path & "\" & Range("A1").Value & ".docx")) = 0 Then
Call FileCopy(str1, PlanDocTemplate)
Else
MsgBox ("The Plan document already exists, please delete or rename the existing Plan Doc in folder " _
& Application.ActiveWorkbook.Path & "\ before creating a new one.")
Exit Sub
End If
strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name
Worksheets("Data").Activate
'Opens New Plan Doc Template
Set appWD = CreateObject("Word.Application")
appWD.Visible = True
appWD.Documents.Open Filename:=PlanDocTemplate
ActiveDocument.MailMerge.OpenDataSource Name:=strWorkbookName, _
Format:=wdMergeInfoFromExcelDDE, _
ConfirmConversions:=True, _
ReadOnly:=False, _
LinkToSource:=True, _
AddToRecentFiles:=False, _
PasswordDocument:="", _
PasswordTemplate:="", _
Revert:=False, _
Connection:="Entire Spreadsheet", _
SQLStatement:="SELECT * FROM `Data$`", _
SQLStatement1:="", _
SubType:=wdMergeSubTypeOther
appWD.Visible = True
appWD.Selection.WholeStory
appWD.Selection.Fields.Update
appWD.Selection.Fields.Unlink
ActiveDocument.MailMerge.MainDocumentType = wdNotAMergeDocument
appWD.ActiveDocument.Save
Worksheets("Form").Activate
MsgBox "Successfully Created " & Range("A1").Value & " in Location: " & Application.ActiveWorkbook.Path & "\"
answer2 = MsgBox("Do you want to save a draft in the E:\ drive as well?", vbYesNo + vbQuestion, "E: Drive Copy")
If answer2 = vbYes Then
If Dir("E:\") <> "" Then
ActiveDocument.SaveAs2 Filename:= _
"E:\" & Range("A1").Value & ".docx", _
FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
:=False, SaveAsAOCELetter:=False, CompatibilityMode:=14
MsgBox ("Successfully Created " & Range("A1").Value & " in E:\ Location.")
Exit Sub
Else
MsgBox ("Please open the E:\ drive and enter your username/password." & _
vbCrLf & vbCrLf & "Click Ok when E:\ drive is opened.")
If Len(Dir("E:\")) = 0 Then
MsgBox ("Error connecting to E:\ drive." & vbCrLf & vbCrLf & "Please ensure you're connected and try again.")
Exit Sub
Else
ActiveDocument.SaveAs2 Filename:= _
"E:\" & Range("A1").Value & ".docx", _
FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
:=False, SaveAsAOCELetter:=False, CompatibilityMode:=14
MsgBox ("Successfully Created " & Range("A1").Value & " in E:\ Location.")
Exit Sub
End If
End If
Else
Exit Sub
End If
End Sub

Search on all opened workbooks for specific data and select that one workbook to use his data

Sub SearchOnWorksheets()
Dim sPrompt As String
Dim msgTrap As VbMsgBoxResult
Dim xWBName As String
Dim xWBAbiertos As String
Dim wSheet As Worksheet
Dim wBook As Workbook
Dim rFound As Range
Dim bFound As Boolean
If Workbooks.Count >= 2 Then
For Each wBook In Application.Workbooks
xWBAbiertos = xWBAbiertos & "[ " & wBook.Name & " ]" & vbCrLf
Next
For Each wBook In Application.Workbooks
For Each wSheet In wBook.Worksheets
Set rFound = Nothing
Set rFound = wSheet.Cells.Find(What:="raya", After:=wSheet.Cells(1, 1), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not rFound Is Nothing Then
bFound = True
xWBName = wBook.Name & vbCrLf
Exit For
End If
Next wSheet
If bFound = True Then Exit For
Next wBook
sPrompt = "Archivos Excel abiertos:" & vbNewLine & _
vbNewLine & xWBAbiertos & vbNewLine & _
vbNewLine & "El archivo de donde se extraerán los gastos es:" & vbNewLine & _
vbNewLine & xWBName & vbNewLine & _
vbNewLine & ""
msgTrap = MsgBox(sPrompt, vbYesNo + vbExclamation, "CUBIMSA")
Select Case msgTrap
Case vbYes
Exit Sub
Case vbNo
Exit Sub
End Select
Else
Call MsgBox("THERE IS NO OPENED ARCHIVE." & vbNewLine & _
vbNewLine & "OPEN ARCHIVE", vbCritical, "ERROR")
Exit Sub
End If
End Sub
In this message appears the file "gastos.xls" because the code looks for the word "raya" in every opened workbook, but I need it to show all the workbooks that met this criteria.
Or maybe if it is possible in all the workbooks look for the sheet "Raya Semanal".
And I need to use this workbook to extract some information, how can I convert this string on something I can copy and paste in other workbook?
something like Workbooks("gastos.xls").Sheets("Raya Semanal").Range("Z16").Value
I think you are asking for 2 things:
I need it to show all the workbooks that met this criteria
In order to record all foundings for all the WBs you would need to change this line xWBName = wBook.Name & vbCrLf to xWBName = wBook.Name & vbCrLf & xWBName
And I need to use this workbook to extract some information, how can I convert this string on something I can copy and paste in other workbook?
I would use the split Function
Like so:
Dim ItemArray as Variant
For Each ItemArray in Split(xWBName ,vbCrlf) 'I may be wrong and probably you should use Chr(10) instead of vbcrlf
Workbooks(Cstr(ItemArray)).Sheets("Raya Semanal").Range("Z16").Value
Next ItemArray