Macro for Creating Word Document!!

[Akash]

Hi,

I have an Excel Sheet with two columns:

Column A - It has got Names as
A1 Akash,
A2 Rohit,
A3 Rakesh
A4 Amit

Column B - It has got contents having Text.

B1 bbbbbbbbbbbbbbbbbb
B2 cccccccccccccccccc
B3 dddddddddddddddddd
B4 eeeeeeeeeeeeeeeeee

What is required is a macro. As soon as we run a Macro, Word document
gets generated Named as Akash.doc and it should have text which is in
Column B1. E.g.

File Name would be A1 "Akash"
And In File named as "Akash.doc" text should be saved as
"bbbbbbbbbbbbbbbbbb"

Pls help me with a Macro to take it forward.

Awaiting for your responses regarding the same.

Rgds

Akash Maheshwari

 

[Claus Busch]

Hi Akash,

Am Mon, 4 Mar 2013 09:33:16 -0800 (PST) schrieb Akash:

A1 Akash,
A2 Rohit,
A3 Rakesh
A4 Amit

Column B - It has got contents having Text.

B1 bbbbbbbbbbbbbbbbbb
B2 cccccccccccccccccc
B3 dddddddddddddddddd
B4 eeeeeeeeeeeeeeeeee

What is required is a macro. As soon as we run a Macro, Word document
gets generated Named as Akash.doc and it should have text which is in
Column B1. E.g.

try:

Sub ExportToWord()
Dim objWord As Object
Dim LRow As Long
Dim rngC As Range
Dim myPath As String

Set objWord = CreateObject("Word.application")
myPath = "C:\Users\Akash Maheshwari\Desktop\"

LRow = Cells(Rows.Count, 1).End(xlUp).Row
For Each rngC In Range("A1:A" & LRow)
With objWord
.Visible = True
.Activate
.documents.Add
.Selection.Text = rngC.Offset(0, 1)
.activedocument.SaveAs Filename:=myPath & rngC & ".docx"
.activedocument.Close
End With
Next
Set objWord = Nothing
End Sub


Regards
Claus Busch

 

[Akash]

Hi Akash,

Am Mon, 4 Mar 2013 09:33:16 -0800 (PST) schrieb Akash:





try:

Sub ExportToWord()
Dim objWord As Object
Dim LRow As Long
Dim rngC As Range
Dim myPath As String

Set objWord = CreateObject("Word.application")
myPath = "C:\Users\Akash Maheshwari\Desktop\"

LRow = Cells(Rows.Count, 1).End(xlUp).Row
For Each rngC In Range("A1:A" & LRow)
   With objWord
      .Visible = True
      .Activate
      .documents.Add
      .Selection.Text = rngC.Offset(0, 1)
      .activedocument.SaveAs Filename:=myPath & rngC & ".docx"
      .activedocument.Close
   End With
Next
Set objWord = Nothing
End Sub

Regards
Claus Busch

Moreover, Its transferring the Tex of first cell but not naming the
file

After the first run its giving Runtime Error.

Pls help in closing the same.

Awaiting for your responses regarding the same.

Rgds

Akash Maheshwari

 

[Claus Busch]

Hi Akash,

Am Mon, 4 Mar 2013 10:31:11 -0800 (PST) schrieb Akash:

Moreover, Its transferring the Tex of first cell but not naming the
file

After the first run its giving Runtime Error.

I tested the code with your 4 examples.
4 documents have been created, the text from column B inserted and named
with the path and the name from column A.
Did you suit the path? Did you start the macro from the correct sheet?


Regards
Claus Busch

 

[Akash]

Hi Akash,

Am Mon, 4 Mar 2013 10:31:11 -0800 (PST) schrieb Akash:



I tested the code with your 4 examples.
4 documents have been created, the text from column B inserted and named
with the path and the name from column A.
Did you suit the path? Did you start the macro from the correct sheet?

Regards
Claus Busch

Its started working.

Thank a tonn.

It saved a lot of time for me.

Thank u once again....

Rgds

Akash Maheshwari

 

[GS]

Is there a specific reason why you have to store the text in Word? A
simple text file (size) would be a lot smaller and require way less
performance overhead that automating Word...

Option Explicit

Sub ExportToTextFile()
Dim vData, n&, k&
Const sPath$ = "C:\Users\Akesh\Desktop\" '//edit to suit

k = Cells(Rows.Count, 1).End(xlUp).Row
vData = Range("$A$1:$B$" & k).Value
For n = LBound(vData) To UBound(vData)
WriteTextFileContents CStr(vData(n, 2)), sPath & vData(n, 1) &
".txt"
Next 'n
End Sub

Sub WriteTextFileContents(TextOut As String, _
Filename As String, _
Optional AppendMode As Boolean = False)
' Reusable procedure that Writes/Overwrites or Appends
' large amounts of data to a Text file in one single step.
' **Does not create a blank line at the end of the file**

Dim iNum As Integer
On Error GoTo ErrHandler
iNum = FreeFile()
If AppendMode Then
Open Filename For Append As #iNum: Print #iNum, vbCrLf & TextOut;
Else
Open Filename For Output As #iNum: Print #iNum, TextOut;
End If

ErrHandler:
Close #iNum: If Err Then Err.Raise Err.Number, , Err.Description
End Sub 'WriteTextFileContents()

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion