Copy shapes from one Word document to another - vba

I am trying to use one master word document to open multiple slave word documents in a folder, scan each slave for shape objects, or images, and copy from the slave to the master? Here is my sample code.
Dim sh as Shape
Path = "C:\users\allwordfiles\"
File = Dir(Path & "*.*")
Do While File <> ""
set oDoc = Documents.Open(FileName:=Path & File)
For Each objShape In oDoc.Shapes
If objShape.InlineShapes.Count > 1 Then
objShape.InlineShapes.SelectAll
Documents("Master.docm").Activate
objShape.InlineShapes.Paste
End If
Next objShape
File = Dir()
This code runs, and there is no error, but nothing seems to be selected in any slave document and nothing is copied over to the master document. I feel like something is nit being referenced correctly, but I can't tell what the actual problem really is. Thoughts? Suggestions?

Related

Managing problematic formatted international characters in filename

I have some files in a folder that seems to be formatted in a strange way when accessing them in VBA.
The code below is a simple test. It scans the Excel-files in a folder and simply opens and closing them again (just to test the problem). It works fine even if the filename contains Swedish characters such as å,ä,ö.
Sub ScanFiles()
Dim ExcelFile As String
Dim WB As Workbook
ExcelFile = Dir("c:\Somepath\*.xlsx")
Do While ExcelFile <> ""
Set WB = Workbooks.Open(ExcelFile)
WB.Close False
Loop
ExcelFile = Dir()
End Sub
This works fine... until... this happens:
One filename is listed as "Sömething.xlsx". Even if I take a detailed look in the file properties. It is really "Sömething.xlsx"!
But the variable ExcelFile stores "So¨mething.xlsx". The Workbooks.Open command fails since the file with that name can't be found
It seems that the specific file has been saved in an Apple environment.
Why is this happening and how do I manage it?

Read a path to a folder from a Excel-Workbook cell using vba

I have the following VBA-code
Dim directory As String, fileName As String
directory = "C:\User\Work\scorix\test_excel\"
fileName = Dir(directory & "*.xl??")
now I would like to change the code so that I would be able to read the path from a given Excel-Workbook cell and then build the fileName.
If I try
directory = Worksheets("Summary").Range("B2").Value
fileName = Dir(directory & "*.xl??")
it dose not work. It means at the end of day directory is empty and therefore fileName is empty.
In the next step I tried
With ThisWorkbook
directory = Sheets("Summary").Range("B2").Value
End With
it works! (But, why?, probably I did not understand the definition of With)
However, in the next step
fileName = Dir(directory & "*.xl??")
filename is still empty. I tried everything with ActiveSheet however, without success!
seems to me those errors occur rather arbitrary, which in my experience can happen when working with several worksheets simultaniously. Maybe replacing
directory = Worksheets("Summary").Range("B2").Value
with
directory = ThisWorkbook.Worksheets("Summary").Range("B2").Value
or alternatively (what is what i prefer to working with a range)
directory = ThisWorkbook.Worksheets("Summary").Cells(2, 2).Value
or alternatively
With ThisWorkbook
' notice the dot in Front of "worksheets"
directory = .Worksheets("Summary").Range("B2").Value
End With
fixes things.
Another situational approach might be to name your Sheet-objects in the VBA-Editor (edit the (Name) property in the property window).
Hope that helps.
P.S.
Since you use the Dir()-Function, I trust you know that in order to get the 2nd+ File, you have to call it repeatedly (maybe in a loop) without supplying a directory.
dir returns the first file in the path\pattern
to recurse you need to do DIR("") pass an empty string
directory = Worksheets("Summary").Range("B2").Value
fileName = Dir(directory & "*.xl??")
there is nothing wrong with this code u might be writing the name of the worksheet wrong maybe?
With ThisWorkbook
directory = Sheets("Summary").Range("B2").Value
End With
Don't forget about using "." before "sheets" when you are using with statements
fileName = Dir(directory & "*.xl??")
The main reason this code didn't work is propably because there are more than one files that ends with "*.xl??" in that folder

Excel macro to open a folder of excel workbooks and copy 1 cell

I have a folder of .xlsx files, each identical in layout.
I need to write a macro in excel to open each file in turn (100+ files)
then get the data (a name) from a single cell, and drop it in a new excel worksheet, move on to the next and insert that below the last one etc.
Giving me basically a list of names from data not file names)
Here is (pretty much) exactly what you're trying to do. Next time do a little bit of googling before you ask! :)
http://www.excel-easy.com/vba/examples/files-in-a-directory.html
ROUGH CODE UNSURE IF IT WILL WORK: But here is the basic idea of what you need to modify in the example I sent you. If you look at the example again, it does everything you need and then some. Since you weren't interested in all worksheets, you don't have to loop through all worksheets in a workbook. You can just open it up, read your cell of interest, and then close it. The Do While loop will do this for every Excel file in your directory. AGAIN! Please modify this example accordingly before you use it.
Dim directory As String, fileName As String, sheet As Worksheet, i As Integer, j As Integer
Application.ScreenUpdating = False
directory = "c:\test\"
fileName = Dir(directory & "*.xl??")
Do While fileName <> ""
i = i + 1
Workbooks.Open (directory & fileName)
Workbooks("files-in-a-directory.xls").Worksheets(1).Cells(i, 1).Value = Workbooks(fileName).Worksheets(1).Cells(x, y) <-- whatever your cell of interest is
Workbooks(fileName).Close
fileName = Dir()
Loop
Application.ScreenUpdating = True

Copy same worksheet in different Excel to one destination Excel file

I have multiple Excel files and they all have the same Worksheet in them named Fixture.
I am trying to copy all of them (they are all in the same folder) and paste them in my destination Excel file under the name of the original Excel file.
For example:
[Excel1]Fixture will be a new worksheet in Main.xlsx named Excel1 after running the VBA. Same with Excel2, Excel3, etc.
Please help!
I suggest you act in four steps:
Create a workbook, e.g. "Collect.xlsx" to collect all "Fixture" sheets
Get your Excel file names and loop through them
In the loop, copy each "Fixture" sheet to your Collect.xlsx
Close and save Collect.xlsx
To 2: You can get the Excel file names either by dir() or by fileDialog:
dir:
http://msdn.microsoft.com/en-us/library/dk008ty4(v=vs.90).aspx
You can use it with or without parameter, thus looping through a
directory. Useful if you want a simple loop, or if you have hundreds of files.
FileDialog: Use the famous FileDialog by Karsten Pries. You can select multiple names
and then loop through them. Download: http://www.kpries.de/download/FileDialog.zip
Your loop might look somehow like this:
...
...
fileDialog.Filter1Suffix = "*.xls"
fileDialog.Filter1Text = "Excel Dokumente"
fileDialog.ShowOpen
fileName = fileDialog.fileName
Do While fileName <> ""
ImportOneSheet fileName ' <<< your own method to collect Fixture
fileName = fileDialog.GetNextFile
Loop
...
If you use dir, just set your ImportOneSheet method in the dir loop.
To 3: Some crucial commands are:
Application.Workbooks.Open (fileName)
Set myExcel = GetObject(, "Excel.Application")
Set importWorkBook = Application.ActiveWorkbook
importWorkBook.Sheets("Fixture").range("A:ZZ").Copy
collectorWorkBook.Sheets(consolidationSheetName).range("A:ZZ").PasteSpecial xlPasteValuesAndNumberFormats, xlPasteSpecialOperationNone, True, False
importWorkBook.Close
These are merely snippets to give you ideas. You might want to find out more about these.
To 4: use the saveAs command: xlam.ActiveWorkbook.SaveAs path, xlOpenXMLWorkbook, , , False, False and the close command: xlam.Workbooks.Close.
For anything remaining, you will find tons of snippets in the net. Good luck :-)

VBA - Copy as Path

I need help with a coding requirement that I've not previously experienced. I just browsed a similar issue raised here a couple of years ago - VBA to Copy files using complete path and file names listed in Excel Object.
My issue is similar but somewhat simpler than the OP.
I have a number of folders that each contain about 100 small .csv files; for each folder I need to copy the path for each file to an open worksheet. Each folder of .csv files has its own associated workbook.
As one example, the open workbook is F:\SM\M400AD.xlsm and the active worksheet is CSV_List. The folder containing the .csv files is F:\SM\M400AD.
Doing it manually, my sequence is then:
Open folder F:\SM\M400AD
Select all
Copy path
Paste to Range("B11") of worksheet CSV_List
When I do it manually, as described above, I get a list that looks like:
"F:\SM\M400AD\AC1.csv"
"F:\SM\M400AD\AC2.csv"
"F:\SM\M400AD\AE.csv"
"F:\SM\M400AD\AF.csv"
"F:\SM\M400AD\AG.csv"
"F:\SM\M400AD\AH1.csv"
"F:\SM\M400AD\AH2.csv"
"F:\SM\M400AD\AJ.csv"
and on down the page until I have a list of 100 paths. This single column list is then pasted into worksheet CSV_List, starting at Range("B11").
I need to automate this and would be grateful if a VBA guru could kindly code this for me.
Such of question has been asked before, for example:
Loop through files in a folder using VBA?
List files in folder and subfolder with path to .txt file
The difference is you want to "automate" it, which means you want to execute code on workbook Open event.
How to achieve that?
Open F:\SM\M400AD.xlsm file.
Go to Code pane (ALT+F11)
Insert new module and copy below code
Option Explicit
Sub EnumCsVFilesInCurrentFolder()
Dim sPath As String, sFileName As String
Dim i As Integer
sPath = ThisWorkbook.Path & "\"
i = 11
Do
If Len(sFileName) = 0 Then GoTo SkipNext
If LCase(Right(sFileName, 4)) = ".csv" Then
'replcae 1 with proper sheet name!
ThisWorkbook.Worksheets(1).Range("B" & i) = sPath & sFileName
i = i + 1
End If
SkipNext:
sFileName = Dir(sPath)
Loop While sFileName <> ""
End Sub
Now, go to ThisWorkbook module and insert below procedure:
Private Sub Workbook_Open()
EnumCsVFilesInCurrentFolder
End Sub
Save and close workbook
The workbook is ready to use. Whenever you open it, EnumCsVFilesInCurrentFolder macro will be executed.
Note: you have to change above code to restrict the number of records.