Switch between Header and CPP file

Introduction

A simple macro that allows you to quickly switch between associated header and implementation files. It's only been tested with Visual Studio 6.

Sub HeaderSourceSwitch()
'DESCRIPTION: Switch between .h and .cpp
'Author: Miezoo (miezoo@f2s.com)

	On Error Resume Next
	Dim sExt, sFile
	
	' current file's extension (all lowercase)
	sExt = fileExtension(ActiveDocument.FullName)
	
	' get file's name (without extension)
	sFile = Left(ActiveDocument.Name, Len(ActiveDocument.Name) - Len(sExt) - 1)

	' valid extension?
	If sExt = "h" or sExt = "hpp" or sExt = "hxx" Then
		sFile = sFile & ".cpp"
	ElseIf sExt = "c" or sExt = "cpp" or sExt = "cxx" Then
		sFile = sFile & ".h"
	Else
		MsgBox "Works for .h and .cpp files only!", vbExclamation, "Error"
		Exit Sub
	End If

	' is the file already opened?
	For Each doc In Application.Documents
		If LCase(doc.Name) = LCase(sFile) Then
			doc.Active = True
			Exit Sub
		End If
	Next

	' see which project contains the damn file
	sFile = findFileWithinWorkspace(sFile)
	Documents.Open sFile

	If Err.Number > 0 Then
		MsgBox "Pair file not found :(", vbCritical, "Error"
		Err.Clear
		Exit Sub
	End If

End Sub


Function findFileWithinWorkspace(file)
'DESCRIPTION: Iterates through all projects (*.dsp) within the current workspace
'             and finds which one owns the given file
	Dim project, bFound, sLine
	sLine = Null

	For Each project In Application.Projects
		' open .dsp file as .txt
		Documents.Open project.FullName, "Text", True
		'if this project is "the one", it must contain a line like: SOURCE=.\path\file
		bFound = ActiveDocument.Selection.FindText(file, dsMatchFromStart + dsMatchRegExp)
		If bFound = True Then
			ActiveDocument.Selection.SelectLine
			sLine = ActiveDocument.Selection
			ActiveDocument.Close
			sLine = Left(sLine, Len(sLine) - 2)		' eliminate LF & CR
			sLine = Right(sLine, Len(sLine) - 8)	' eliminate SOURCE=.\
			
			If Left(sLine, 1) <> "." Then
				sLine = filePath(project.FullName) & sLine
			End If
			
			Exit For
		End If
		ActiveDocument.Close
	Next

	findFileWithinWorkspace = sLine
End Function


Function fileExtension(file)
'DESCRIPTION: Returns file extension.
	Dim iPos, iDot
	
	iDot = Null
	Do While True
		iPos = Instr(1, file, ".", 1)
		If iPos = 0 or iPos = Null Then
			Exit Do
		Else
			file = Right(file, Len(file) - iPos)
			iDot = iPos
		End If
	Loop

	If iDot = Null Then
		fileExtension = ""
	Else
		fileExtension = LCase(file)
	End If

End Function


Function filePath(file)
'DESCRIPTION: Returns file path (without the trailing backslash "\").
	Dim iPos, iBS, strPath
	
	strPath = file
	iBS = Null
	Do While True
		iPos = Instr(1, file, "\", 1)
		If iPos = 0 or iPos = Null Then
			Exit Do
		Else
			file = Right(file, Len(file) - iPos)
			iBS = iPos
		End If
	Loop

	If iBS = Null Then
		filePath = ""
	Else
		filePath = Left(strPath, Len(strPath) - Len(file) - 1)
	End If
End Function