Word VBA fails pasting into Footnotes - vba

I am trying to copy a piece of formatted text from one (rtf) document into a field in a Word document.
In Word2003, copy and paste via the clipboard works, but in Word2010, if the target range is in a footnote then the Paste operation fails (actually does nothing but does not give an error). In Word2010 however, using PasteSpecial works, but in Word365 that fails too.
This is my code:
If IsObjectValid(extIndex.getHeadingText(i)) Then
                        extIndex.getHeadingText(i).Copy
                        fieldCode.Collapse (wdCollapseEnd)
                        fieldCode.Paste
                    Else
Is there some other way to do this or am I doing something wrong?

Related

MS Access Password Protect PDF using Ghostscript - PDF document blank

this is my first post - be gentle!
I am looking to password protect PDF Reports from MS Access(version 2013)
I found this question and answer on Stack useful but have hit a snag
When the report is created it has all the necessary information but after calling the function (to password protect the PDF) the PDF report is blank. Name is the same and the PDF is password protected - but its blank!
The instruction being passed to Ghostscript is
-q -dSAFER -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOwnerPassword=170284 -sUserPassword=170284 -dCompatibilityLevel=2.0 -sOutputFile=D:\Data\ Report.pdf
the public function from the original (slightly modified) is
Public Function fctPDO_Print_pdf_GhostScript(strSourceFolder As String, strTargetFolder As String, strFile_for_pdf As String, Optional strUserPassword As String = "", Optional strOwnerPassword As String = "") As String
' http://www.herber.de/forum/archiv/1164to1168/1165503_Zusammenfuehren_von_PDF_Files.html#1165503
' https://stackoverflow.com/questions/49953421/ghostscript-with-aes-256-password-protection-for-pdf-2-0-documents
' PDO: Prints a pdf (originally multi-pdf). Requires Ghostscript, and read/write rights.
' Existing files are overwritten without asking.
' Provide both passwords to lock. Ghostscript does rc4 , being comparatively unsafe.
'
On Error Resume Next
Dim fso As Object, WshShell As Object
Dim strCommand As String
Dim strGhostScript As String
Set fso = CreateObject("Scripting.FileSystemObject")
'Path to gswin32c.exe
strGhostScript = "C:\Program Files (x86)\gs9.54.0\bin\gswin64c.exe"
'Shell-command prepare
strTargetFolder = fso.GetFolder(strTargetFolder).ShortPath
strGhostScript = fso.GetFile(strGhostScript).ShortPath
'PDO: Password-Phrase, with Ghostscript only RC4 possible...
strCommand = strGhostScript & " -q -dSAFER -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOwnerPassword=" & strOwnerPassword
strCommand = strCommand & " -sUserPassword=" & strUserPassword & " -dCompatibilityLevel=2.0"
strCommand = strCommand & " -sOutputFile=" & strTargetFolder & "\" & strFile_for_pdf
'Execute
Debug.Print strCommand
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run strCommand, 0, True
Set WshShell = Nothing
fctPDO_Print_pdf_GhostScript = strTargetFolder & strFile_for_pdf
' Cleanup:
Err_Handler:
Set fso = Nothing
End Function
I have tried numerous things to debug including passing variation of the instruction but without much success - this is above my paygrade
I am hopeful someone can spot the error and assist
thanks in advance
Thanks to #Kens for the tips. Updated code which now works:
Public Function fctPDO_Print_pdf_GhostScript(strSourceFolder As String, strTargetFolder As String, strOriginalFile As String, strTargetFile As String, Optional strUserPassword As String = "", Optional strOwnerPassword As String = "") As String
' PDO: Prints a pdf (originally multi-pdf). Requires Ghostscript, and read/write rights.
' Existing files are overwritten without asking.
' Provide both passwords to lock. Ghostscript does rc4 , being comparatively unsafe.
'
On Error Resume Next
Dim fso As Object, WshShell As Object
Dim strCommand As String
Dim strGhostScript As String
Set fso = CreateObject("Scripting.FileSystemObject")
'Path to gswin32c.exe
strGhostScript = "C:\Program Files (x86)\gs9.54.0\bin\gswin64c.exe"
'Shell-command prepare
strTargetFolder = fso.GetFolder(strTargetFolder).ShortPath
strGhostScript = fso.GetFile(strGhostScript).ShortPath
'PDO: Password-Phrase, with Ghostscript only RC4 possible...
strCommand = strGhostScript & " -q -dSAFER -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOwnerPassword=" & strOwnerPassword
strCommand = strCommand & " -sUserPassword=" & strUserPassword & " -dCompatibilityLevel=2.0"
strCommand = strCommand & " -sOutputFile=" & strTargetFolder & "\" & strTargetFile
strCommand = strCommand & " " & strSourceFolder & "\" & strOriginalFile
'Execute
Debug.Print strCommand
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run strCommand, 0, True
Set WshShell = Nothing
fctPDO_Print_pdf_GhostScript = strTargetFolder & strTargetFile
' Cleanup:
Err_Handler:
Set fso = Nothing
End Function

Returning sender/from address on outlook in compose mode via VBA

I have just one exchange account on outlook and access to two shared/group mailbox or mail address which are created by admin. I am just a member of that shared mail group and I can send and receive mails via them. So sometimes I make a mistake by choosing wrong sender address. I need to check sender/from address and recipients before sending emails. However, I can't return sender/from addresses as a string via VBA. I choose them by 'from' drop down menu.
Here is my code:
Dim Recipients As Outlook.Recipients
Dim recip As Outlook.Recipient
Dim i
Dim prompt As String
Dim Send_Address As String
Dim checker As Integer
Send_Address = Item.SendUsingAccount.SmtpAddress
checker = 0
Set Recipients = Item.Recipients
For i = Recipients.Count To 1 Step -1
    Set recip = Recipients.Item(i)
    If InStr(LCase(recip.Address), "abc.com") Then
    checker = 1
    End If
    If InStr(LCase(recip.Address), "xyz.com") Then
    checker = 2
    End If
Next i
If (Send_Address = "abc.om") And (checker = 1) Then
    MsgBox ("Please check CC list. It includes different clients.")
    Cancel = True
ElseIf (Send_Address = "xyz.com") And (checker = 2) Then
    MsgBox ("Please check CC list. It includes different clients.")
    Cancel = True
Else
    MsgBox ("OK" & checker & Send_Address)
    Cancel = True
End If
End Sub
The From value is in .SentOnBehalfOfName. It is not updated on a GUI change.
Update the value with code. The GUI will remain unchanged.
Option Explicit
Sub updateFromValue()
Dim Item As mailItem
Dim mailbox1 As String
Dim mailbox2 As String
Dim mailbox3 As String
Dim resp As String
' first create a draft for testing
Set Item = ActiveInspector.currentItem
Item.Display
Debug.Print ".SentOnBehalfOfName: " & Item.SentOnBehalfOfName
mailbox1 = "abc.com"
mailbox2 = "xyz.com"
mailbox3 = "default.com"
resp = InputBox("1: " & mailbox1 & vbCr & "2: " & mailbox2 & vbCr & "3: " & mailbox3)
If Len(resp) > 0 Then
Select Case resp
Case 1
Item.SentOnBehalfOfName = mailbox1
Debug.Print "Item.SentOnBehalfOfName: " & Item.SentOnBehalfOfName
Case 2
Item.SentOnBehalfOfName = mailbox2
Debug.Print "Item.SentOnBehalfOfName: " & Item.SentOnBehalfOfName
Case 3
Item.SentOnBehalfOfName = mailbox3
Debug.Print "Item.SentOnBehalfOfName: " & Item.SentOnBehalfOfName
Case Else
Debug.Print "?"
End Select
End If
End Sub
Now you can verify the value of .SentOnBehalfOfName in Application_ItemSend.

Microsoft Access - Link pictures to database automatically based on folder directory + firstname lastname

Hi I cant find anything regarding this, would be great if someone could point me in the right direction.
I have an access database with 4000 gym members.
I want to add profile pictures by linking from a given directory.
I dont want to manually link 4000 pictures
I want it to automatically search in the directory and match the firstname + last name + DOB of the member with the picture which will have the identical
eg: bobjones05121989
Thanks ahead for your help.
Are you using Access 2007 or later? Use the ControlSource property of Image control. An expression can construct the file path, like:
="C:\somepath\" & [FirstName] & [LastName] & Format([DOB], "ddmmyyyy") & ".jpg"
If image doesn't exist the Image control will be blank.
You can modify the function UrlContent to link from some other field(s) than ID, and not (as here) download anything (you have the files already) but just return the path of the picture:
' Download (picture) file from a URL of a hyperlink field to a
' (temporary) folder, and return the full path to the downloaded file.
'
' This can be used as the control source for a bound picture control.
' If no Folder is specified, the user's IE cache folder is used.
'
' Typical usage in the RecordSource for a form or report where Id is
' the unique ID and Url is the hyperlink field holding the URL to
' the picture file to be displayed:
'
'   - to a cached file where parameter Id is not used:
'
'   Select *, UrlContent(0, [Url]) As Path From SomeTable;
'
'   - or, where Id is used to create the local file name:
'
'   Select *, UrlContent([Id], [Url], "d:\somefolder") As Path From SomeTable;
'
' Then, set ControlSource of the bound picture control to: Path
'
' 2017-05-28. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function UrlContent( _
    ByVal Id As Long, _
    ByVal Url As String, _
    Optional ByVal Folder As String) _
    As Variant
    Const NoError   As Long = 0
    Const Dot       As String = "."
    Const BackSlash As String = "\"
   
    Dim Address     As String
    Dim Ext         As String
    Dim Path        As String
    Dim Result      As String
   
    ' Strip leading and trailing octothorpes from URL string.
    Address = HyperlinkPart(Url, acAddress)
    ' If Address is a zero-length string, Url was not wrapped in octothorpes.
    If Address = "" Then
        ' Use Url as is.
        Address = Url
    End If
   
    If Folder = "" Then
        ' Import to IE cache.
        Result = DownloadCacheFile(Address)
    Else
        If Right(Folder, 1) <> BackSlash Then
            ' Append a backslash.
            Folder = Folder & BackSlash
        End If
   
        ' Retrieve extension of file name.
        Ext = StrReverse(Split(StrReverse(Address), Dot)(0))
        ' Build full path for downloaded file.
        Path = Folder & CStr(Id) & Dot & Ext
       
        If DownloadFile(Address, Path) = NoError Then
            Result = Path
        End If
    End If
   
    UrlContent = Result
   
End Function
An article and a full demo can be found here:
Show pictures directly from URLs in Access forms and reports
Try this when the form loads.
You need to change the field names to the actual names of your database.
Private Sub Form_Load()
Dim imagepath As String
With Me
imagepath = "Drive:\" & LCase(![FirstName]) & LCase(![LastName]) & Format(![DOB], "ddmmyyyy") & ".jpg"
End With
If Len(Dir(imagepath)) > 0 Then
Me.ImageControl.Picture = imagepath
End If
End Sub

How to do a pivot - group by - pivot

I have this dataset:
DatasetMonthYear
Month   Year    Id     Person_Id          Name
-----------------------------------------------------
1       2007    855    5987456            John Slow
2       2007    850    5987456            John Slow
1       2007    254    5987456            John Slow
2       2008    987    5987456            John Slow
1       2007    456    5454543            Mary Jane
1       2007    454    5454543            Mary Jane
2       2008    554    5454543            Mary Jane 
i need to group or count one row by month, Id and Person_Id, but counting that occurrence as one,  so i make this query.
select pv.Person_Id,  pv.Name,  pv.Year,
(CASE [1] when 0 THEN 0 else 1 end) as January,
   (CASE [2] when 0 THEN 0 else 1 end) as Februry
from DatasetMonthYear as P 
pivot ( count(Id) for
Month in ([1], [2]) ) as pv
the result is this dataset:
Person_Id   Name         Year  January    February
------------------------------------------------------
5987456     John Snow    2007     1          0
5987456     John Snow    2007     0          1
5987456     John Snow    2008     0          1
5454543     Mary Jane    2007     1          0
5454543     Mary Jane    2008     0          1
now i need the sum of each month by one Person_Id on a year, so i try add another pivot as follows.
select Person_Id,Name, [2007], [2008]
from (select pv.Person_Id,pv.Name, Year, (CASE [1] when 0 THEN 0 else 1 end) as January,
               (CASE [2] when 0 THEN 0 else 1 end) as February
from DatasetMonthYear as P
pivot ( count(Id) for
Month in ([1], [2]) ) as pv) as resulset
pivot( sum() for Year in ([2007],[2008]) ) as apv
and here is where i am stuck. i need a grouping by Person_ID, a sum of each month (January + Februry+...+etc) and pivot in years
Result i want :
2007    2008    Person_Id   Name
2       1     5987456     John Snow
1       1     5454543     Mary Jane
I don't think you need two Pivots here, you can get your desired result using one Pivot, see below
select * from
(
select DISTINCT Person_Id, name, Year, Month From DatasetMonthYear
) Src
Pivot
(
Count(Month) For Year In ([2007],[2008])
) Pvt
SQL Demo

Pull Columns based on row value

I have a table X
ID A B C D
1 T T F T
2 F T F T
3 T F T F
So if my input is 1 for ID, then I want all column names that have value T for row 1. In above case A,B,D or If ID is 3 then A and C.
How could I list these columns?
You can use UNPIVOT for this
SELECT Y
FROM Table1
UNPIVOT (X FOR Y IN ([A], [B], [C], [D])) U
WHERE [ID] = 1 AND X = 'T'
Returns
+---+
| Y |
+---+
| A |
| B |
| D |
+---+
SQL Fiddle
Also you can use XQuery with powerful FLWOR Expression. And no matter how many columns contains a table;)
SELECT(
SELECT *
FROM Table1 t
WHERE ID = 1
FOR XML PATH(''), TYPE
).query(
'for $spec in ./*
where $spec [contains(., "T")]
return fn:local-name($spec)'
) o
Demo on SQLFiddle
This decision returns the names of columns on each row
SELECT o.TCols.value('.', 'nvarchar(100)') AS T
FROM(SELECT(
            SELECT *     
            FROM Table1 t
            WHERE ID = 1
            FOR XML PATH(''), TYPE
            ).query('
                     for $spec in ./*
                     where $spec [contains(., "T")]           
                     return (
                             <TCols>
                               {fn:local-name($spec)}
                             </TCols>
                             )
                     ')) t(TCols) CROSS APPLY T.TCols.nodes('/TCols') o(TCols)
Results
+---+
| T |
+---+
| A |
| B |
| D |
+---+
Demo on SQLFiddle
In case that you know the number and name of all columns, you may do the below
SELECT case A when 'T' then 'A' else '' end
+ case B when 'T' then ',B' else '' end
+ case C when 'T' then ',C' else '' end
+ case D when 'T' then ',D' else '' end
FROM
Table1
WHERE ID = 1