rango - Cómo copiar el mensaje de correo de Outlook en Excel usando VBA o Macros

macro para exportar datos de outlook a excel

Question

Esta es mi primera publicación. Soy un novato en VBA y Macros. Si alguien me ayuda con el código VBA y las macros, será útil.

Diariamente recibiré alrededor de 50-60 correos con un tema estándar: "Tarea completada". He creado una regla para todos esos correos para mover a una carpeta específica: "Tarea completada".

Leer todos los correos de 50-60 al día y actualizar todos los correos electrónicos consume mucho tiempo. Todos los 50-60 correos que lleguen a mi bandeja de entrada tendrán el mismo tema pero de diferentes usuarios. El cuerpo del correo variará.

Estoy usando Outlook 2010 y Excel 2010

Gracias y toda su ayuda será muy apreciada.

Answer 1

Como no ha mencionado lo que debe copiarse, he dejado esa sección vacía en el código siguiente.

Además, no es necesario mover el correo electrónico a la carpeta primero y luego ejecutar la macro en esa carpeta. Puede ejecutar la macro en el correo entrante y luego moverla a la carpeta al mismo tiempo.

Esto te ayudará a comenzar. He comentado el código para que no tenga problemas para entenderlo.

Primero pegue el código mencionado a continuación en el módulo de perspectivas.

Entonces

1. Haga clic en Herramientas ~~> Reglas y alertas
2. Haga clic en "Nueva regla"
3. Haga clic en "comenzar desde una regla en blanco"
4. Seleccione "Comprobar mensajes cuando lleguen"
5. En condiciones, haga clic en "con palabras específicas en el tema"
6. Haga clic en "palabras específicas" bajo la descripción de las reglas.
7. Escriba la palabra que desea verificar en el cuadro de diálogo que aparece y haga clic en "agregar".
8. Haga clic en "Aceptar" y haga clic en Siguiente
9. Seleccione "moverlo a la carpeta especificada" y también seleccione "ejecutar un script" en el mismo cuadro
10. En el cuadro siguiente, especifique la carpeta específica y también la secuencia de comandos (la macro que tiene en el módulo) para ejecutar.
11. Haga clic en finalizar y listo.

Cuando llegue el nuevo correo electrónico, el correo electrónico no solo se moverá a la carpeta que especifique, sino que también se exportarán datos a Excel.

NO PRUEBA

Const xlUp As Long = -4162
Sub ExportToExcel(MyMail As MailItem)
Dim strID As String, olNS As Outlook.Namespace
Dim olMail As Outlook.MailItem
Dim strFileName As String
''~~> Excel Variables
Dim oXLApp As Object, oXLwb As Object, oXLws As Object
Dim lRow As Long
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set olMail = olNS.GetItemFromID(strID)
''~~> Establish an EXCEL application object
On Error Resume Next
Set oXLApp = GetObject(, "Excel.Application")
''~~> If not found then create new instance
If Err.Number <> 0 Then
Set oXLApp = CreateObject("Excel.Application")
End If
Err.Clear
On Error GoTo 0
''~~> Show Excel
oXLApp.Visible = True
''~~> Open the relevant file
Set oXLwb = oXLApp.Workbooks.Open("C:/Sample.xls")
''~~> Set the relevant output sheet. Change as applicable
Set oXLws = oXLwb.Sheets("Sheet1")
lRow = oXLws.Range("A" & oXLApp.Rows.Count).End(xlUp).Row + 1
''~~> Write to outlook
With oXLws
''
''~~> Code here to output data from email to Excel File
''~~> For example
''
.Range("A" & lRow).Value = olMail.Subject
.Range("B" & lRow).Value = olMail.SenderName
''
End With
''~~> Close and Clean up Excel
oXLwb.Close (True)
oXLApp.Quit
Set oXLws = Nothing
Set oXLwb = Nothing
Set oXLApp = Nothing
Set olMail = Nothing
Set olNS = Nothing
End Sub

SEGUIR

Para extraer el contenido de su cuerpo de correo electrónico, puede dividirlo usando SPLIT () y luego analizar la información relevante desde él. Mira este ejemplo

Dim MyAr() As String
MyAr = Split(olMail.body, vbCrLf)
For i = LBound(MyAr) To UBound(MyAr)
''~~> This will give you the contents of your email
''~~> on separate lines
Debug.Print MyAr(i)
Next i

Answer 2

Nueva introducción 2

En la versión anterior de la macro "SaveEmailDetails" utilicé esta declaración para encontrar Inbox:

Set FolderTgt = CreateObject("Outlook.Application"). _
GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

Desde entonces, instalé una versión más nueva de Outlook y descubrí que no usa la Bandeja de entrada predeterminada. Para cada una de mis cuentas de correo electrónico, creó una tienda separada (nombrada para la dirección de correo electrónico), cada una con su propia Bandeja de entrada. Ninguna de esas bandejas de entrada es la predeterminada.

Esta macro, muestra el nombre de la tienda que contiene la Bandeja de entrada predeterminada en la ventana Inmediato:

Sub DsplUsernameOfDefaultStore()
Dim NS As Outlook.NameSpace
Dim DefaultInboxFldr As MAPIFolder
Set NS = CreateObject("Outlook.Application").GetNamespace("MAPI")
Set DefaultInboxFldr = NS.GetDefaultFolder(olFolderInbox)
Debug.Print DefaultInboxFldr.Parent.Name
End Sub

En mi instalación, esta salidas: "Archivo de datos de Outlook".

He agregado una declaración adicional a la macro "GuardarEmailDetails" que muestra cómo acceder a la Bandeja de entrada de cualquier tienda.

Nueva introducción 1

Varias personas han recogido el siguiente macro, lo han encontrado útil y me han contactado directamente para obtener más información. Después de estos contactos, realicé algunas mejoras en el macro, así que publiqué la versión revisada a continuación. También he agregado un par de macros que juntas devolverán el objeto MAPIFolder para cualquier carpeta con la jerarquía de Outlook. Estos son útiles si desea acceder a otra carpeta que no sea la predeterminada.

El texto original hacía referencia a una pregunta por fecha que se vinculaba con una pregunta anterior. La primera pregunta ha sido eliminada por lo que el enlace se ha perdido. Ese enlace fue para actualizar la hoja de Excel en función del correo de Outlook (cerrado)

Texto original

Hay una cantidad sorprendente de variaciones de la pregunta: "¿Cómo extraigo los datos de los correos electrónicos de Outlook a los libros de Excel?" Por ejemplo, dos preguntas en [outlook-vba] la misma pregunta se hizo el 13 de agosto. Esa pregunta hace referencia a una variación de diciembre que intenté responder.

Para la pregunta de diciembre, fui por la borda con una respuesta de dos partes. La primera parte fue una serie de macros de enseñanza que exploraron la estructura de carpetas de Outlook y escribieron datos en archivos de texto o libros de Excel. La segunda parte discutió cómo diseñar el proceso de extracción. Para esta pregunta, Siddarth ha proporcionado una respuesta excelente y breve y luego un seguimiento para ayudar con la próxima etapa.

Lo que la persona que pregunta de cada variación parece incapaz de comprender es que al mostrarnos cómo se ven los datos en la pantalla no nos dice cómo es el texto o el cuerpo html. Esta respuesta es un intento de superar ese problema.

La siguiente macro es más complicada que la de Siddarth, pero mucho más simple que las que incluí en mi respuesta de diciembre. Hay más que podría agregarse, pero creo que esto es suficiente para empezar.

La macro crea un nuevo libro de trabajo de Excel y genera las propiedades seleccionadas de cada correo electrónico en la Bandeja de entrada para crear esta hoja de trabajo:

Cerca de la parte superior de la macro hay un comentario que contiene ocho hashes (#). La declaración debajo de ese comentario debe modificarse porque identifica la carpeta en la que se creará el libro de Excel.

Todos los demás comentarios que contienen hashes sugieren enmiendas para adaptar la macro a sus requisitos.

¿Cómo se identifican los correos electrónicos de los que se extraerán los datos? ¿Es el remitente, el sujeto, una cadena dentro del cuerpo o todos estos? Los comentarios proporcionan cierta ayuda para eliminar correos electrónicos poco interesantes. Si entiendo la pregunta correctamente, un correo electrónico interesante tendrá Subject = "Task Completed" .

Los comentarios no proporcionan ayuda para extraer datos de correos electrónicos interesantes, pero la hoja de trabajo muestra tanto el texto como las versiones html del cuerpo del correo electrónico, si están presentes. Mi idea es que pueda ver lo que verá la macro y comenzar a diseñar el proceso de extracción.

Esto no se muestra en la imagen de la pantalla de arriba, pero la macro genera dos versiones en el cuerpo del texto. La primera versión no se modifica, lo que significa que se respetan las tabulaciones, el retorno de carro, el avance de línea y los espacios que no se rompen como espacios. En la segunda versión, he reemplazado estos códigos con las cadenas [TB], [CR], [LF] y [NBSP] para que sean visibles. Si mi comprensión es correcta, esperaría ver lo siguiente dentro del segundo cuerpo del texto:

Actividad [TAB] Recuento [CR] [LF] Abierto [TAB] 35 [CR] [LF] HCQA [TAB] 42 [CR] [LF] HCQC [TAB] 60 [CR] [LF] HAbst [TAB] 50 45 5 2 2 1 [CR] [LF] y así sucesivamente

Extraer los valores del original de esta cadena no debería ser difícil.

Intentaría modificar mi macro para mostrar los valores extraídos además de las propiedades del correo electrónico. Solo cuando haya logrado este cambio, intentaré escribir los datos extraídos en un libro existente. También movería correos electrónicos procesados ​​a una carpeta diferente. He mostrado dónde deben realizarse estos cambios pero no les proporciono más ayuda. Responderé a una pregunta complementaria si llega al punto en que necesita esta información.

Buena suerte.

La última versión de macro incluida en el texto original

Option Explicit
Public Sub SaveEmailDetails()
'' This macro creates a new Excel workbook and writes to it details
'' of every email in the Inbox.
'' Lines starting with hashes either MUST be changed before running the
'' macro or suggest changes you might consider appropriate.
Dim AttachCount As Long
Dim AttachDtl() As String
Dim ExcelWkBk As Excel.Workbook
Dim FileName As String
Dim FolderTgt As MAPIFolder
Dim HtmlBody As String
Dim InterestingItem As Boolean
Dim InxAttach As Long
Dim InxItemCrnt As Long
Dim PathName As String
Dim ReceivedTime As Date
Dim RowCrnt As Long
Dim SenderEmailAddress As String
Dim SenderName As String
Dim Subject As String
Dim TextBody As String
Dim xlApp As Excel.Application
'' The Excel workbook will be created in this folder.
'' ######## Replace "C:/DataArea/SO" with the name of a folder on your disc.
PathName = "C:/DataArea/SO"
'' This creates a unique filename.
'' #### If you use a version of Excel 2003, change the extension to "xls".
FileName = Format(Now(), "yymmdd hhmmss") & ".xlsx"
'' Open own copy of Excel
Set xlApp = Application.CreateObject("Excel.Application")
With xlApp
'' .Visible = True '' This slows your macro but helps during debugging
.ScreenUpdating = False '' Reduces flash and increases speed
'' Create a new workbook
'' #### If updating an existing workbook, replace with an
'' #### Open workbook statement.
Set ExcelWkBk = xlApp.Workbooks.Add
With ExcelWkBk
'' #### None of this code will be useful if you are adding
'' #### to an existing workbook. However, it demonstrates a
'' #### variety of useful statements.
.Worksheets("Sheet1").Name = "Inbox" '' Rename first worksheet
With .Worksheets("Inbox")
'' Create header line
With .Cells(1, "A")
.Value = "Field"
.Font.Bold = True
End With
With .Cells(1, "B")
.Value = "Value"
.Font.Bold = True
End With
.Columns("A").ColumnWidth = 18
.Columns("B").ColumnWidth = 150
End With
End With
RowCrnt = 2
End With
'' FolderTgt is the folder I am going to search. This statement says
'' I want to seach the Inbox. The value "olFolderInbox" can be replaced
'' to allow any of the standard folders to be searched.
'' See FindSelectedFolder() for a routine that will search for any folder.
Set FolderTgt = CreateObject("Outlook.Application"). _
GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
'' #### Use the following the access a non-default Inbox.
'' #### Change "Xxxx" to name of one of your store you want to access.
Set FolderTgt = Session.Folders("Xxxx").Folders("Inbox")
'' This examines the emails in reverse order. I will explain why later.
For InxItemCrnt = FolderTgt.Items.Count To 1 Step -1
With FolderTgt.Items.Item(InxItemCrnt)
'' A folder can contain several types of item: mail items, meeting items,
'' contacts, etc. I am only interested in mail items.
If .Class = olMail Then
'' Save selected properties to variables
ReceivedTime = .ReceivedTime
Subject = .Subject
SenderName = .SenderName
SenderEmailAddress = .SenderEmailAddress
TextBody = .Body
HtmlBody = .HtmlBody
AttachCount = .Attachments.Count
If AttachCount > 0 Then
ReDim AttachDtl(1 To 7, 1 To AttachCount)
For InxAttach = 1 To AttachCount
'' There are four types of attachment:
'' * olByValue 1
'' * olByReference 4
'' * olEmbeddedItem 5
'' * olOLE 6
Select Case .Attachments(InxAttach).Type
Case olByValue
AttachDtl(1, InxAttach) = "Val"
Case olEmbeddeditem
AttachDtl(1, InxAttach) = "Ebd"
Case olByReference
AttachDtl(1, InxAttach) = "Ref"
Case olOLE
AttachDtl(1, InxAttach) = "OLE"
Case Else
AttachDtl(1, InxAttach) = "Unk"
End Select
'' Not all types have all properties. This code handles
'' those missing properties of which I am aware. However,
'' I have never found an attachment of type Reference or OLE.
'' Additional code may be required for them.
Select Case .Attachments(InxAttach).Type
Case olEmbeddeditem
AttachDtl(2, InxAttach) = ""
Case Else
AttachDtl(2, InxAttach) = .Attachments(InxAttach).PathName
End Select
AttachDtl(3, InxAttach) = .Attachments(InxAttach).FileName
AttachDtl(4, InxAttach) = .Attachments(InxAttach).DisplayName
AttachDtl(5, InxAttach) = "--"
'' I suspect Attachment had a parent property in early versions
'' of Outlook. It is missing from Outlook 2016.
On Error Resume Next
AttachDtl(5, InxAttach) = .Attachments(InxAttach).Parent
On Error GoTo 0
AttachDtl(6, InxAttach) = .Attachments(InxAttach).Position
'' Class 5 is attachment. I have never seen an attachment with
'' a different class and do not see the purpose of this property.
'' The code will stop here if a different class is found.
Debug.Assert .Attachments(InxAttach).Class = 5
AttachDtl(7, InxAttach) = .Attachments(InxAttach).Class
Next
End If
InterestingItem = True
Else
InterestingItem = False
End If
End With
'' The most used properties of the email have been loaded to variables but
'' there are many more properies. Press F2. Scroll down classes until
'' you find MailItem. Look through the members and note the name of
'' any properties that look useful. Look them up using VB Help.
'' #### You need to add code here to eliminate uninteresting items.
'' #### For example:
''If SenderEmailAddress <> "[email protected]" Then
'' InterestingItem = False
''End If
''If InStr(Subject, "Accounts payable") = 0 Then
'' InterestingItem = False
''End If
''If AttachCount = 0 Then
'' InterestingItem = False
''End If
'' #### If the item is still thought to be interesting I
'' #### suggest extracting the required data to variables here.
'' #### You should consider moving processed emails to another
'' #### folder. The emails are being processed in reverse order
'' #### to allow this removal of an email from the Inbox without
'' #### effecting the index numbers of unprocessed emails.
If InterestingItem Then
With ExcelWkBk
With .Worksheets("Inbox")
'' #### This code creates a dividing row and then
'' #### outputs a property per row. Again it demonstrates
'' #### statements that are likely to be useful in the final
'' #### version
'' Create dividing row between emails
.Rows(RowCrnt).RowHeight = 5
.Range(.Cells(RowCrnt, "A"), .Cells(RowCrnt, "B")) _
.Interior.Color = RGB(0, 255, 0)
RowCrnt = RowCrnt + 1
.Cells(RowCrnt, "A").Value = "Sender name"
.Cells(RowCrnt, "B").Value = SenderName
RowCrnt = RowCrnt + 1
.Cells(RowCrnt, "A").Value = "Sender email address"
.Cells(RowCrnt, "B").Value = SenderEmailAddress
RowCrnt = RowCrnt + 1
.Cells(RowCrnt, "A").Value = "Received time"
With .Cells(RowCrnt, "B")
.NumberFormat = "@"
.Value = Format(ReceivedTime, "mmmm d, yyyy h:mm")
End With
RowCrnt = RowCrnt + 1
.Cells(RowCrnt, "A").Value = "Subject"
.Cells(RowCrnt, "B").Value = Subject
RowCrnt = RowCrnt + 1
If AttachCount > 0 Then
.Cells(RowCrnt, "A").Value = "Attachments"
.Cells(RowCrnt, "B").Value = "Inx|Type|Path name|File name|Display name|Parent|Position|Class"
RowCrnt = RowCrnt + 1
For InxAttach = 1 To AttachCount
.Cells(RowCrnt, "B").Value = InxAttach & "|" & _
AttachDtl(1, InxAttach) & "|" & _
AttachDtl(2, InxAttach) & "|" & _
AttachDtl(3, InxAttach) & "|" & _
AttachDtl(4, InxAttach) & "|" & _
AttachDtl(5, InxAttach) & "|" & _
AttachDtl(6, InxAttach) & "|" & _
AttachDtl(7, InxAttach)
RowCrnt = RowCrnt + 1
Next
End If
If TextBody <> "" Then
'' ##### This code was in the original version of the macro
'' ##### but I did not find it as useful as the other version of
'' ##### the text body. See below
'' This outputs the text body with CR, LF and TB obeyed
''With .Cells(RowCrnt, "A")
'' .Value = "text body"
'' .VerticalAlignment = xlTop
''End With
''With .Cells(RowCrnt, "B")
'' '' The maximum size of a cell 32,767
'' .Value = Mid(TextBody, 1, 32700)
'' .WrapText = True
''End With
''RowCrnt = RowCrnt + 1
'' This outputs the text body with NBSP, CR, LF and TB
'' replaced by strings.
With .Cells(RowCrnt, "A")
.Value = "text body"
.VerticalAlignment = xlTop
End With
TextBody = Replace(TextBody, Chr(160), "[NBSP]")
TextBody = Replace(TextBody, vbCr, "[CR]")
TextBody = Replace(TextBody, vbLf, "[LF]")
TextBody = Replace(TextBody, vbTab, "[TB]")
With .Cells(RowCrnt, "B")
'' The maximum size of a cell 32,767
.Value = Mid(TextBody, 1, 32700)
.WrapText = True
End With
RowCrnt = RowCrnt + 1
End If
If HtmlBody <> "" Then
'' ##### This code was in the original version of the macro
'' ##### but I did not find it as useful as the other version of
'' ##### the html body. See below
'' This outputs the html body with CR, LF and TB obeyed
''With .Cells(RowCrnt, "A")
'' .Value = "Html body"
'' .VerticalAlignment = xlTop
''End With
''With .Cells(RowCrnt, "B")
'' .Value = Mid(HtmlBody, 1, 32700)
'' .WrapText = True
''End With
''RowCrnt = RowCrnt + 1
'' This outputs the html body with NBSP, CR, LF and TB
'' replaced by strings.
With .Cells(RowCrnt, "A")
.Value = "Html body"
.VerticalAlignment = xlTop
End With
HtmlBody = Replace(HtmlBody, Chr(160), "[NBSP]")
HtmlBody = Replace(HtmlBody, vbCr, "[CR]")
HtmlBody = Replace(HtmlBody, vbLf, "[LF]")
HtmlBody = Replace(HtmlBody, vbTab, "[TB]")
With .Cells(RowCrnt, "B")
.Value = Mid(HtmlBody, 1, 32700)
.WrapText = True
End With
RowCrnt = RowCrnt + 1
End If
End With
End With
End If
Next
With xlApp
With ExcelWkBk
'' Write new workbook to disc
If Right(PathName, 1) <> "/" Then
PathName = PathName & "/"
End If
.SaveAs FileName:=PathName & FileName
.Close
End With
.Quit '' Close our copy of Excel
End With
Set xlApp = Nothing '' Clear reference to Excel
End Sub

Las macros no se incluyen en la publicación original pero que algunos usuarios de la macro anterior han encontrado útiles.

Public Sub FindSelectedFolder(ByRef FolderTgt As MAPIFolder, _
ByVal NameTgt As String, ByVal NameSep As String)
'' This routine (and its sub-routine) locate a folder within the hierarchy and
'' returns it as an object of type MAPIFolder
'' NameTgt The name of the required folder in the format:
'' FolderName1 NameSep FolderName2 [ NameSep FolderName3 ] ...
'' If NameSep is "|", an example value is "Personal Folders|Inbox"
'' FolderName1 must be an outer folder name such as
'' "Personal Folders". The outer folder names are typically the names
'' of PST files. FolderName2 must be the name of a folder within
'' Folder1; in the example "Inbox". FolderName2 is compulsory. This
'' routine cannot return a PST file; only a folder within a PST file.
'' FolderName3, FolderName4 and so on are optional and allow a folder
'' at any depth with the hierarchy to be specified.
'' NameSep A character or string used to separate the folder names within
'' NameTgt.
'' FolderTgt On exit, the required folder. Set to Nothing if not found.
'' This routine initialises the search and finds the top level folder.
'' FindSelectedSubFolder() is used to find the target folder within the
'' top level folder.
Dim InxFolderCrnt As Long
Dim NameChild As String
Dim NameCrnt As String
Dim Pos As Long
Dim TopLvlFolderList As Folders
Set FolderTgt = Nothing '' Target folder not found
Set TopLvlFolderList = _
CreateObject("Outlook.Application").GetNamespace("MAPI").Folders
'' Split NameTgt into the name of folder at current level
'' and the name of its children
Pos = InStr(NameTgt, NameSep)
If Pos = 0 Then
'' I need at least a level 2 name
Exit Sub
End If
NameCrnt = Mid(NameTgt, 1, Pos - 1)
NameChild = Mid(NameTgt, Pos + 1)
'' Look for current name. Drop through and return nothing if name not found.
For InxFolderCrnt = 1 To TopLvlFolderList.Count
If NameCrnt = TopLvlFolderList(InxFolderCrnt).Name Then
'' Have found current name. Call FindSelectedSubFolder() to
'' look for its children
Call FindSelectedSubFolder(TopLvlFolderList.Item(InxFolderCrnt), _
FolderTgt, NameChild, NameSep)
Exit For
End If
Next
End Sub
Public Sub FindSelectedSubFolder(FolderCrnt As MAPIFolder, _
ByRef FolderTgt As MAPIFolder, _
ByVal NameTgt As String, ByVal NameSep As String)
'' See FindSelectedFolder() for an introduction to the purpose of this routine.
'' This routine finds all folders below the top level
'' FolderCrnt The folder to be seached for the target folder.
'' NameTgt The NameTgt passed to FindSelectedFolder will be of the form:
'' A|B|C|D|E
'' A is the name of outer folder which represents a PST file.
'' FindSelectedFolder() removes "A|" from NameTgt and calls this
'' routine with FolderCrnt set to folder A to search for B.
'' When this routine finds B, it calls itself with FolderCrnt set to
'' folder B to search for C. Calls are nested to whatever depth are
'' necessary.
'' NameSep As for FindSelectedSubFolder
'' FolderTgt As for FindSelectedSubFolder
Dim InxFolderCrnt As Long
Dim NameChild As String
Dim NameCrnt As String
Dim Pos As Long
'' Split NameTgt into the name of folder at current level
'' and the name of its children
Pos = InStr(NameTgt, NameSep)
If Pos = 0 Then
NameCrnt = NameTgt
NameChild = ""
Else
NameCrnt = Mid(NameTgt, 1, Pos - 1)
NameChild = Mid(NameTgt, Pos + 1)
End If
'' Look for current name. Drop through and return nothing if name not found.
For InxFolderCrnt = 1 To FolderCrnt.Folders.Count
If NameCrnt = FolderCrnt.Folders(InxFolderCrnt).Name Then
'' Have found current name.
If NameChild = "" Then
'' Have found target folder
Set FolderTgt = FolderCrnt.Folders(InxFolderCrnt)
Else
''Recurse to look for children
Call FindSelectedSubFolder(FolderCrnt.Folders(InxFolderCrnt), _
FolderTgt, NameChild, NameSep)
End If
Exit For
End If
Next
'' If NameCrnt not found, FolderTgt will be returned unchanged. Since it is
'' initialised to Nothing at the beginning, that will be the returned value.
End Sub