Save RTF document as word

Convert RTF document To Word

Sub Open_n_Save()

sFile = Dir$("C:\ReFormated\*.rtf", vbNormal)
Do Until Len(sFile) = 0
Documents.Open "C:\ReFormated\" & sFile
ActiveDocument.SaveAs "C:\ReFormated\" & sFile & ".doc", wdFormatDocument
ActiveDocument.Close False
sFile = Dir$
Loop


End Sub

See also :

Excel VBA - 1004 -- The file could not be accessed

Save and Reopen all Workbooks (Excel VBA)

Save copy of the workbook

SaveAs Dialog - Controlled Save

Using Excel Functions in VBA

Excel has several useful functions, which can be implemented in VBA code using the Evaluate Method

Evaluate Method converts a Microsoft Excel name to an object or a value


For example , the following method adds the values of the cells A1 to A6.

Sub Evaluate_Usage()

Dim lSum As Long

lSum = Evaluate("=SUM(A1:A6)")

End Sub

USe of evaluate has reduced a roundabout way of looping thru the cells and summing it up.

What next.. use the sum if, count if functions and evaluate!!!

Display text in a multiple lines

To display several lines of text in a text box, using vbcrlf at the end of each line

Set MultiLine property to True either in the Properties window

alternatively this can be set in runtime like:

TextBox1.MultiLine = True

Display Time Dynamically

Display Time Dynamically in Form using Time/Now Function

Add a Timer Control to your form and set the timer interval.

In the Timer event for that timer set (refresh) the time

Private Sub Timer1_Timer()

Label1.Caption = Date & " " & Time

End Sub

In the Form Load Event Intialize the interval
Private Sub Form_Load()
Timer1.Interval = 1000
End Sub

Execute Excel Macro in All Files

You can use the following code to execute the macro in all Excel (.xls) files under a given folder. You can tweek a bit if necessary

Sub Exec_Macro_For_All()

Dim sPath As String
Dim sFile As String
Dim sDir As String
Dim oWB As Workbook
Dim i1 As Long
Dim iMax As Long

On Error GoTo Err_Clk

sPath = "" ' Your Path
If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"

sDir = Dir$(sPath & "*.xls", vbNormal)
Do Until LenB(sDir) = 0
Set oWB = Workbooks.Open(sPath & sDir)
Exec_MyMacro() ' Your MAcro here
oWB.Save
oWB.Close False
sDir = Dir$
Loop

Err_Clk:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Sub

Cheers
Shasur

Get User Name using Split Function

This is a simple way of using the split function to get the user name

Sub Get_EMail_User_Name()

sEmail = "joe@gmail.com"

arTemp = Split(sEmail, "@")

sDomain = arTemp(LBound(arTemp))
End Sub

Cheers
Shasur

Get Domain Name from eMail (Split Function)

This is a simple way of using the split function to get the domain name

Sub Get_Domain()

sEmail = "joe@gmail.com"

arTemp = Split(sEmail, "@")

sDomain = arTemp(UBound(arTemp))
End Sub

Cheers
Shasur

Disabling Excel events

In some cases, we would have written some code in Worksheet_SelectionChange, Workbook_SheetActivate, etc and do not want them to be fired. This will be used if you have some event to be fired when the user enters a value, but do not want them if the value is from VBA code etc. In that case switch off the Application.EnableEvents and turnit on after the

process.

Sub Donot_Fire_Events()

Application.EnableEvents = False

' Coding to skip these events

Application.EnableEvents = True

End Sub

Excel Not Calculating Formula

If Excel does not re-calculate the formula. That is, if the cell is not refreshed inspite of newvalues, the Calculation might not be set as automatic. To set the calculation as automatic, use the following:

Sub Switch_On_XL_Calculation()

Application.Calculation = xlCalculationAutomatic

End Sub

Transferring array to Excel range

Is there any method to transfer the contents of the array to an Excel Range.. Most often programmers used to loop thru the array and put it to the Excel (of course with another loop). Here is a simple code that will transfer the array contents to Excel. Many thanks to Sharmila Purushotaman for this thoughful article

Sub Sheet_Fill_Array()
Dim myarray As Variant
myarray = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
Range("A1:A10").Select
Range("A1:A10").Value = Application.WorksheetFunction.Transpose(myarray)
End Sub

' Keywords : ARRAY to Excel, Transferring array to range

Character to ASCII

This function will print the ASCII values for corresponding characters in the first and second column respectively

Sub Convert2_Asc_Values()

For i1 = 1 To 256

Cells(i1 + 1, 3).Value = Asc(Cells(i1 + 1, 2).Value)

Next i1
End Sub



AddMe - Search Engine Optimization

ASCII to Character

There have been many times that we want to know the ASCII values. Ths function will print the character codes for the ASCII values in the first and second column respectively

Sub Print_Asc_Values()
For i1 = 1 To 255
Cells(i1 + 1, 1) = i1 Cells(i1 + 1, 2) = Chr(i1) Next i1
End Sub

Cheers
Shasur

Shared Name For the Drive

QueryDosDeviceW API Function can be used to get the device name.

To get the Shared Name of the drive, use the following function:

Public Function ConvertDrive2ServerName(ByVal sFullPath As String) As String


' --- Replaces the DriveName with ShareName in a given string

Dim FSO As FileSystemObject

Dim sDrive As String

Dim drvName As Drive

Dim sShare As String



On Error GoTo Err_Trap



Set FSO = New FileSystemObject



sDrive = FSO.GetDriveName(sFullPath)

Set drvName = FSO.GetDrive(sDrive)

sShare = drvName.ShareName



If LenB(sShare) <> 0 Then

ConvertDrive2ServerName = Replace(sFullPath, sDrive, sShare, 1, 1, vbTextCompare)

Else

ConvertDrive2ServerName = sFullPath

End If

If Not FSO Is Nothing Then Set FSO = Nothing



' ---------------------------------------

' Error Handling

' ---------------------------------------

Err_Trap:

If Err <> 0 Then

Err.Clear

Resume Next

End If

End Function

The function returns the DriveName with ShareName in a given string. It is advisable for programmers to store all the file locations using Sharename instead of DriveName

Cheers

Shasur

Get the Device Name (API Function)

Declare the API Function

Private Declare Function QueryDosDeviceW Lib "kernel32.dll" ( _ ByVal lpDeviceName As Long, _ ByVal lpTargetPath As Long, _ ByVal ucchMax As Long _ ) As Long Const MAX_PATH = 260

The following function accepts the drive as string and returns the device name

Public Function GetNtDeviceNameForDrive( _

ByVal sDrive As String) As String



Dim bDrive() As Byte

Dim bResult() As Byte

Dim lR As Long

Dim sDeviceName As String



If Right(sDrive, 1) = "\" Then

If Len(sDrive) > 1 Then

sDrive = Left(sDrive, Len(sDrive) - 1)

End If

End If

bDrive = sDrive



ReDim Preserve bDrive(0 To UBound(bDrive) + 2) As Byte

ReDim bResult(0 To MAX_PATH * 2 + 1) As Byte



lR = QueryDosDeviceW(VarPtr(bDrive(0)), VarPtr(bResult(0)), MAX_PATH)

If (lR > 2) Then

sDeviceName = bResult

sDeviceName = Left(sDeviceName, lR - 2)

GetNtDeviceNameForDrive = sDeviceName

End If



End Function


For example

Sub Trial()

MsgBox GetNtDeviceNameForDrive("c:")

End Sub

Dir Function in VBA (Visual Basic)

Dir or Dir$ Function can be used in Microsoft Visual Basic (Applications) to get the list of directories or files

sDir = Dir$(sPath & "*.xls", vbNormal)

Do Until LenB(sDir) = 0

Set oWB = Workbooks.Open(sPath & sDir)

‘ Do some stuff

oWB.close

sDir = Dir$

Loop

The above will open all Excel Workbooks under a particular directory.

Excel VBA - How to Know if the Cell Has Formula

To get the cell that contains formula couple of useful properties are available in Excel VBA

1. HasFormula
2. SpecialCells(xlCellTypeFormulas)

HasFormula will give True or False depending on the availabiliy of formulas

whereas

SpecialCells(xlCellTypeFormulas) can be used to select all the cells that contain formula

cells.SpecialCells(xlCellTypeFormulas).Select

or Set rng = cells.SpecialCells(xlCellTypeFormulas)

For each Cll in Rng

' Each cell containing formula

Next


Cheers
Shasur

Excel VBA InputBox

Excel VBA InputBox

InputBox method in Excel is more useful than the conventional inputBox functions when you require the user to select some range.

It is used as Application.InputBox

The Application.InputBox method differs from the usual InputBox function in that it allows selective validation of the user's input, and it can be used with Microsoft Excel objects, error values, and also formulas.

Application.InputBox calls the InputBox method; InputBox with no object qualifier calls the InputBox function.

MyRange = Application.InputBox("Select the Range?","My Application")

Homerweb Search

MSFlexGrid datasource - Object variable not defined

When you try to use MSFlexGrid.datasource the error 'Object variable not defined; pops up.

Try using the combination of Heirarchial FlexGrid and ADO Data Control


Adodc1.RecordSource = "Select * From Table"

and

Set MSHFlexGrid1.DataSource = Adodc1

Now the FlexGrid will be populated with the data from the ADO Data Control. This is more useful as this can be modified at run-time.



Cheers
Shasur

Category: MSFlexGrid.datasource error

Faster Program Execution - Microsoft

Faster Program Execution is the dream of every developer. Here are some few tips for that. This is tested for Microsoft Visual Basic programs

Replace all Trim(), Left(), Right(), Mid() etc with Trim$(), Left$(), Right$(), Mid$() . These are string functions which will increase the speed

Also

If you are comparing if a string is empty

use

Len(Trim("STring")) = 0

rather than

Trim("STring") = ""

Even better would be

LenB(Trim$("STring")) = 0

as LenB() would be faster than Len().


More functions in coming articles...

Cheers
Shasur






Free Search Engine Submission

BreakLinks - Microsoft Excel

Use the following code to break the links to external source in Microsoft Excel Workbook


Sub Break_XL_Links()

Dim oXlLinks

oXlLinks = ActiveWorkbook.LinkSources(xlExcelLinks)

MsgBox UBound(oXlLinks)

For i = 1 To UBound(oXlLinks)
MsgBox oXlLinks(i)
Next i

ActiveWorkbook.Breaklink Name:=oXlLinks(1), Type:=xlLinkTypeExcelLinks

End Sub