copying and Renaming files based on list in MS Word

[Dan]

Hi Everyone,
I have done VBA in Excell before but never in word. I have a list of File Names in different directeries than the word document but they are relative to the document. After a revision has been made to a drawing it goes in the list in the word file. I want to make a macro that reads the file name and revision number and copies that file to the "Issued For Construction" (that is also relative) folder and add the revision number to the end of the name of the drawing. I dont even know where to start.:dunno:help The table is not the excell table that is embedded into word. It is just a simple table. there are 2 tables and the one with the information is the second table. Any help would greatly be apreciated.:beg:
Thanks,
Dan

[mdmackillop]

Hi Dan
Welcome to VBAX
Can you post your file to we can see the layout etc.? Zip it and use Manage Attachments in the Go Advanced section
Regards
MD

[Dan]

Thanks for the quick reply.
The XXXX-X-XXX Under Company Doc No. stands for JobNo-Skid-DwgDiscipline

The directory Tree looks like this
JobNo
-Drawings
--In Progress
---100
---200
---300
---400
---500
---600
---700
---800
--Issued For Construction
-Transmittals
--Shop

The Transmittal is located under Shop
100-800 are the different DwgDisciplines
Thanks again for your help. I really appreciate it.
Dan
6173

[mdmackillop]

Hi Dan
I'm not at all clear how XXXX-X-XXX relates to your file structure. Have a look at this code though, which splits it into parts and gets the revision number. The parts are then joined together to create the file path/name and for the new file location.
Option Explicit

Sub CopyDwgs()
Dim Dwg, Original As String, Revision As String
Dim MyDwg As String, Rev As String
Dim MyStr
Dim i As Long

With ActiveDocument.Tables(2)
For i = 2 To .Rows.Count
'Split DocNo into path
MyStr = Stripped(.Cell(i, 5))
If MyStr = "" Then Exit Sub
Dwg = Split(MyStr, "-")
MyDwg = Dwg(0) & "\" & Dwg(1) & "\" & Dwg(2)

'Get revision
Rev = Stripped(.Cell(i, 6))

Original = "C:\" & MyDwg & ".doc"
Revision = "C:\AAA\" & Dwg(1) & "\Issued For Construction\" _
& Dwg(2) & "_" & Rev & ".doc"

FileCopy Original, Revision
Next
End With
End Sub

'Remove trailing characters from text
Function Stripped(Data) As String
On Error GoTo Errh
Do Until Asc(Right(Data, 1)) > 48
Data = Left(Data, Len(Data) - 1)
Loop
Stripped = Data
Exit Function
Errh:
Stripped = ""
End Function

[Dan]

Thanks mdmackillop. I cant thank you enough.:bow: It gives me a great place to start. I just have to modify the code a little bit to find the current working dirrectory and to copy stuff relative to that. Thanks again. i really appreicate it.
Dan

[mdmackillop]

Try
MsgBox ActiveDocument.Path

[Dan]

Thanks,
That works great. I need to remove part of the directory string now.
Thanks again,
Dan

[fumei]

underscore character please.

[mdmackillop]

:whip

[fumei]

My, my, aren't we both fast AND polite. Thank you.

BTW: is there any way to reduce the indentation size in the VBA code window? That would help.

[mdmackillop]

Hi Gerry,
I did have an underscore, but was in quotes.:devil2:
Re the indents, maybe http://www.thecodenet.com/ can advise.

[Dan]

hey everybody,
The code works great. I just have one problem though. When a revision is 0 then the rev variable is null. i think it has something to do in this code snippet:
'Remove trailing characters from text
Function Stripped(Data) As String
On Error Goto Errh
Do Until Asc(Right(Data, 1)) > 48
Data = Left(Data, Len(Data) - 1)
Loop
Stripped = Data
Exit Function
Errh:
Stripped = ""
End Function I was thinking:think: that i could just replace "Stripped = """ with "Stripped = "0"" but i am pretty sure that there is a better way to fix it that I dont know of. I just wanted to get a second opinion. Also sometimes the Revision is a letter such a A. I am just confused with this function but understand the rest of the code. Thanks for the help.
Dan

UPDATE: I replace "Do Until Asc(Right(Data, 1)) > 48" with "Do Until Asc(Right(Data, 1)) >= 48" which make it greater then or equal to 48 (the code for ASC I think). sometime it added spaces the the beginning of the value of the Rev variable but i fixed that by adding "Rev = Trim(Rev)" and that fixed it.:biggrin:

[mdmackillop]

Stripped="0" should be OK.

The text from the cells included multiple "end" characters, and I seemed to get different Ascii codes. I created Stripped to remove any character less than the value of "a". An error occurs if there is no revision character, hence the error handler to return "", "0" or whatever you wish if there is no revision.
Your use of Trim for leading spaces is fine. You could use Stripped = Trim(Data) to handle this within the function.

[Dan]

Thank you very much again for the help mdmackillop. I really appreciate it. it all work know except i am trying to figure out how to open the folder that the dwg's were place in. Any Ideas?
Thanks,
Dan

[mdmackillop]

Of course!
Sub ExplorePath()
Shell Environ("windir") & "\Explorer.exe " & ActiveWorkbook.Path, vbMaximizedFocus
End Sub

[mdmackillop]

Download the zip file here (http://vbaexpress.com/forum/showpost.php?p=52488&postcount=6). It lets you download KB summaries and search them. Might help get you started, and we're always here to assist

[fumei]

FYI - Just to connect to another thread....

The code:Rev = Stripped(.Cell(i, 6)) passes the contents of Cell(i,6) to Stripped, 'tis true. But what it actually does is pass the contents as a Variant. It would be better to pass it as either the text contents (.Range.Text), or as a cell object.

The text from the cells included multiple "end" characters, and I seemed to get different Ascii codes. Table cells have a peculiar end-of-cell marker. It is a unique "double" character. Chr(13) and Chr(7).

There are a variety of ways to deal with this. Either using a string input parameter, or a cell input. Assuming of course you want a string OUT.

String Version Function:
Function CellText(strIn As String) As String
CellText = Left(strIn, Len(strIn) - 2)
End Function In which case you can use:Rev = CellText(.Cell(i, 6).Range.Text)

OR, if it may be more useful to have access to other object properties along the way, you can use a cell object.

Cell Version Function:
Function CellText2(aCell As Cell) As String
Dim sText As String
sText = aCell.Range.Text
CellText2 = Left(sText, Len(sText) - 2)
End FunctionIn which case, the code would be:Rev = CellText2(.Cell(i, 6))Of course adding Trim is often useful (or required). I am not being critical, it is just that coding by using a threshold of a numeric ASCII code seems...clunky.

Dan - could you explain "i am trying to figure out how to open the folder that the dwg's were place in."?

1. what do you mean open the folder? Do you mean open a file?

2. do you not HAVE the folder path name in your code? It is contained in the Revision string. Why not use it?

[mdmackillop]

Hi Gerry,
Some of the cells also contained a pilcrow making the "-2" problematical, hence the contrived Stripped.
I forgot about that #'**% Range method so couldn't get my String to work!

[Dan]

Dan - could you explain "i am trying to figure out how to open the folder that the dwg's were place in."?

1. what do you mean open the folder? Do you mean open a file?

2. do you not HAVE the folder path name in your code? It is contained in the Revision string. Why not use it?

The Code that i had help writing is made to copy a drawing (dwg) to a specified folder and ad the revision number to the drawing name. i then wanted that folder to open in explorer.exe when the code was finished. i have it figured out now though.
Thanks,
Dan

[Dan]

Hey everybody,
The Code works great. It works exactly how I wanted to to. I couldn't have done it without yall's help. Thanks again.
I have a question though. Even when word and any other office products (except outlook) are closed the VBA editing window pops up. I dont know when this happens though. i just notice that it is opened up when i get to work in the morning. I am very puzzled as I have never run into this issue before. :dunno Anyone have any ideas.
Thanks for the help.
Dan

[fumei]

Aaaaaack! Underscore character please!