I'm trying to loop through files in a folder and take data for that files using references, im using below code , but still getting Update Values window popped up at every file in which I have to manually select path of files. How to do this reference automatically
[Salary.Value is name of a cell in files in that folder]
Dim myfolder As String
Dim myfile As String
Dim wbk As Workbook
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "please select a folder"
.Show
.AllowMultiSelect = False
myfolder = .SelectedItems(1) & "\"
End With
myfile = Dir(myfolder)
Do While myfile <> ""
Set wbk = Workbooks.Open(Filename:=myfolder & myfile)
' the next line is the one in question
Range("I6").FormulaR1C1 = "='myfile'!Salary.value"
myfile = Dir
Loop
End Sub
A browse window named update values is popping up
'MyFile' is a variable name. But how you use it, it is considered as name of the workbook.
Try
Range("I6").FormulaR1C1 = "='" + MyFile + "'!Salary.value"
instead
Related
We import a CSV file into excel from Creo, this is our Bill of materials, We create the drawing PDF's and DXF's and save them in two 'MASTER' folders. When issuing the drawings to a manufacturer we must copy every individual drawing to a separate folder before sending.
The solution I am working on is to use a userform to select the 'copyfrom' location and 'copyto' location, on the 'run' command button, a sub should copy the files across.
I have the used the copy code by entering the folder locations in the Sub routine, but i need to allow other users to choose other files. The userform is adding the folder locations to the specific textboxes, but the next sub routine to copy the pdfs will not work.
I think it may be the textbox value is not recorded?
As a side I would also like to return the number of moved PDF's as part of the message in the Message box once the routine has completed. This may be different to the number of used cells in column B
The part number of the drawing will always be in column B
I haven't created the DXF option yet, but it will be very similar to the PDF one if i can get it to work
Any and all help much appreciated.
Private Sub cmdclose_Click()
Unload Me
End Sub
Private Sub copyfromcmd_Click()
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
'.InitialFileName = Application.GetSaveAsFilename()
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
copyfromtb.Value = sItem
Set fldr = Nothing
End Sub
Private Sub copytocmd_Click()
Dim fldr As FileDialog
Dim sItem2 As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
'.InitialFileName = Application.GetSaveAsFilename()
If .Show <> -1 Then GoTo NextCode
sItem2 = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem2
copytotb.Value = sItem2
Set fldr = Nothing
End Sub
Private Sub runcmd_Click()
Dim R As Range
Dim SourcePath As String, DestPath As String, FName As String
'Setup source and dest path (Note: must have a trailing backslash!)
SourcePath = Me.copyfromtb.Value
DestPath = Me.copytotb.Value
'Visit each used cell in column B
For Each R In Range("B1", Range("B" & Rows.Count).End(xlUp))
'Search the file with the file mask from the cell (Note: can contain wildcards like *.xls)
FName = Dir(SourcePath & R.Value & ".pdf")
'Loop while files found
Do While FName <> ""
'Copy the file
FileCopy SourcePath & FName, DestPath & FName
'Search the next file
FName = Dir()
Loop
Next
MsgBox ("PDF's Copied")
End Sub
Expected Results:
When the Copy Files command button is clicked, the pdf files from part numbers listed in column B will be copied from the first folder location to the second folder location.
If the entries are blank a message should appear which will request folder location are selected
Once the PDF's have been moved a message should appear to tell the user the number of files which have been copied.
Actual Results:
The folder location is being entered into the required textbox, but the PDF's are not being copied over
try this
dim counter as integer
counter = 0
'Visit each used cell in column B
For Each R In Range("B1", Range("B" & Rows.Count).End(xlUp))
'Search the file with the file mask from the cell (Note: can contain wildcards like *.xls)
FName = Dir(SourcePath & R.Value & ".pdf")
'Loop while files found
Do While FName <> ""
counter = counter + 1
'Copy the file
FileCopy SourcePath & FName, DestPath & FName
'Search the next file
FName = Dir()
Loop
Next
MsgBox (counter & " PDF's Copied")
good luck
I just realized my error
I need to add the trailing backslash!
SourcePath = Me.copyfromtb.Value
DestPath = Me.copytotb.Value
Changed to
SourcePath = copyfromtb.Value & "\"
DestPath = copytotb.Value & "\"
Still having issues with counting the number of moved files and adding that value to the message box at the end
I have vba code to convert a ppt to pptx file, but how do I preserve the file properties (author/created date, modified date, etc)? Here is the vba code that converts the, in this case .ppt file, to a pptx file.
Sub BatchSave()
' Opens each PPT in the target folder and saves as PowerPoint 2007/2010 (.pptx) format
Dim sFolder As String
Dim sPresentationName As String
Dim oPresentation As Presentation
Dim bidpList As Collection
' Select the folder:
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.Title = "Select folder and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", , "List Folder Contents"
Exit Sub
End If
sFolder = fDialog.SelectedItems.Item(1)
If Right(sFolder, 1) <> "\" Then sFolder = sFolder + "\"
End With
' Make sure the folder name has a trailing backslash
If Right$(sFolder, 1) <> "\" Then
sFolder = sFolder & "\"
End If
' Are there PPT files there?
If Len(Dir$(sFolder & "*.PPT")) = 0 Then
MsgBox "Bad folder name or no PPT files in folder."
Exit Sub
End If
' Open and save the presentations
sPresentationName = Dir$(sFolder & "*.PPT")
While sPresentationName <> ""
Set oPresentation = Presentations.Open(sFolder & sPresentationName, , ,
False)
Call oPresentation.SaveAs(sFolder & sPresentationName & "x")
oPresentation.Close
Wend
MsgBox "DONE"
End Sub
Declaring object variables for your two presentations will simplify the code a bit, and then you can do something along these lines:
Dim oPres As Presentation
Dim oCopyPres As Presentation
Dim x As Long
Set oPres = ActivePresentation
ActivePresentation.SaveCopyAs "c:\temp\test.pptx"
Set oCopyPres = Presentations.Open("c:\temp\test.pptx")
On Error Resume Next
For x = 1 To oPres.BuiltInDocumentProperties.Count
oCopyPres.BuiltInDocumentProperties(x).Name = oPres.BuiltInDocumentProperties(x).Name
oCopyPres.BuiltInDocumentProperties(x).Value = oPres.BuiltInDocumentProperties(x).Value
Next
You'll want to modify this to set WithWindow false and to use variables as file names, but you're already doing that in the code you have. It should be simple enough to fold in a modified version of the code above.
I had used some code I found on here to start trying to convert a big list of Excel CSV files to Excel 2003 format. In the process of converting I wanted to open a default location folder then navigate to the right sub-folder where the CSV files are, however when stepping through the code one of my variables will not populate. My code is below and the variable that won't populate is strDir.
I'm wanting code to populate strDir with the default location + the folder that I pick, however I'm unsure what I need to do to this code to enable it to do that.
Right now I only have the default location hard-coded and when code runs, this location opens. however when I pick the sub-folder how do I record that programatically?
I know what I want to do but how to achieve this in VBA is my question.
Public Sub CSV_to_XLS()
Dim wb As Workbook
Dim strFile As String
Dim strDir As String
Dim strDirCapture As String
'Set base directory for get folder to manipulate csv files
strDirCapture = GetFolder("\\DEVP-APPS-07\File Storgae\1_Pending\")
'strDir = strDirCapture
strDir = strDirCapture & "\"
strFile = Dir(strDir & "*.csv")
MsgBox "String directory path = " & strDirCapture
MsgBox "StrFile = " & strFile
Do While strFile <> ""
'Set wb = Workbooks.Open(Filename:=strDir & strFile, Local:=True)
'wb.SaveAs Replace(wb.FullName, ".csv", ".xls"), 56 'UPDATE:
wb.Close True
Set wb = Nothing
strFile = Dir
Loop
End Sub
Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
Many thanks
Andrew
Update adding slash "\" to end of directory captured seems to have fixed this. Have altered code above to reflect this change.
Try adding these lines after strDir = strDirCapture:
If Right(strDir, 1) <> "\" Then
strDir = strDir & "\"
End If
I am hoping to find a solution (be it VBA or not) to my problem. I have a Word document with linked Excel tables in it. All links work correctly, but I have to manually open the Word document in order for it to refresh with the Excel data. The reason I am using Word instead of Excel is due to the large amounts of text.
Is there a way that I could program some sort of code that would go through all Word documents in a folder, open each document, refresh all links, save document, and move onto the next one?
Here's what I have so far
Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
MyFolder = "LOCATION"
MyFile = Dir(MyFolder & "\*.docx")
Do While MyFile <> ""
Documents.Open Filename:=MyFolder & "\" & MyFile
MyFile = Dir
Loop
End Sub
UPDATE
Ok I was able to make the open files command work! Now I am attempting to make it overwrite/save the file and close it.
Error Message: Object Required
Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
Dim objWord As Object
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
MyFolder = "LOCATION"
MyFile = Dir(MyFolder & "\*.docx")
Do While MyFile <> ""
objWord.Documents.Open Filename:=MyFolder & "\" & MyFile
Application.DisplayAlerts = False
ActiveDocument.SaveAs Filename:=MyFile
Application.DisplayAlerts = True
MyFile = Dir
Loop
End Sub
You can try any of below:
Dim objDoc As Object
Do While Myfile <> ""
Set objDoc = objWord.Documents.Open(Filename:=MyFolder & "\" & MyFile)
objDoc.Save '~~> Save
objDoc.Close '~~> Close
Myfile = Dir
Loop
Or you can just use Close Method like this.
objDoc.Close True '~~> close with SaveChanges argument set to True
I have the following code that opens all files in a specified folder
Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
MyFolder = "\\ILAFILESERVER\Public\Documents\Renewable Energy\FiTs\1 Planning Department\Marks Tracker\Quality Control Reports"
MyFile = Dir(MyFolder & "\*.xlsx")
Do While MyFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyFile
MyFile = Dir
Loop
End Sub
Is it possible to have a similar code that closes all files in the folder. Many thanks in advance for any assistance provided on this matter.
Workbooks.Open will return a reference to the pointer of the workbook. Save this in a Collection (using Collection.Add) as soon as you open the workbook. When you want to close all the workbooks, iterate through the collection (using For Each) and close each element. Then remove all elements from the collection.
Try
Workbooks.Close
From the Excel Visual Basic Help documentation:
This example closes all open workbooks. If there are changes in any open workbook, Microsoft Excel displays the appropriate prompts and dialog boxes for saving changes.
Do you need to have them all open at the same time? Because otherwise:
Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
MyFolder = "\\ILAFILESERVER\Public\Documents\Renewable Energy\FiTs\1 Planning Department\Marks Tracker\Quality Control Reports"
MyFile = Dir(MyFolder & "\*.xlsx")
Dim wb As Workbook
Do While MyFile <> ""
Set wb = Workbooks.Open Filename:=MyFolder & "\" & MyFile
'Do stuff
wb.Close False 'The false will close without saving
MyFile = Dir
Loop
End Sub