Optional Owner As Long, _
                    Optional Printer As Object, _
                    Optional flags As Long, _
                    Optional Hook As Boolean = False _
                ) As Boolean
    Dim afFlags As Long

    m_lApiReturn = 0
    m_lExtendedError = 0

    ' Set PRINTDLG flags
    afFlags = flags
    afFlags = afFlags Or (Abs(DisablePageNumbers) * PD_NOPAGENUMS) Or _
              (Abs(DisablePrintToFile) * PD_DISABLEPRINTTOFILE) Or _
              (Abs(DisableSelection) * PD_NOSELECTION) Or _
              (Abs(PrintToFile) * PD_PRINTTOFILE) Or _
              (Abs(Not ShowPrintToFile) * PD_HIDEPRINTTOFILE) Or _
              (Abs(PreventWarning) * PD_NOWARNING) Or _
              (Abs(Collate) * PD_COLLATE) Or _
              PD_USEDEVMODECOPIESANDCOLLATE Or _
              PD_RETURNDC
    If PrintRange = eprPageNumbers Then
        afFlags = afFlags Or PD_PAGENUMS
    ElseIf PrintRange = eprSelection Then
        afFlags = afFlags Or PD_SELECTION
    End If
    ' Mask out unwanted bits
    afFlags = afFlags And Not PD_ENABLEPRINTHOOK
    afFlags = afFlags And Not PD_ENABLEPRINTTEMPLATE
    afFlags = afFlags And Not PD_ENABLESETUPHOOK
    afFlags = afFlags And Not PD_ENABLESETUPTEMPLATE_C

    ' Fill in PRINTDLG structure
    Dim pd As TPRINTDLG
    pd.lStructSize = Len(pd)
    pd.hwndOwner = Owner
    pd.flags = afFlags
    pd.nFromPage = FromPage
    pd.nToPage = ToPage
    pd.nMinPage = 1
    pd.nMaxPage = &HFFFF

    ' Show Print dialog
    m_lApiReturn = PrintDlg(pd)

    Select Case m_lApiReturn
    Case 1
        VBPrintDlg = True
        ' Return dialog values in parameters
        hdc = pd.hdc
        If (pd.flags And PD_PAGENUMS) Then
            PrintRange = eprPageNumbers
        ElseIf (pd.flags And PD_SELECTION) Then
            PrintRange = eprSelection
        Else
            PrintRange = eprAll
        End If
        FromPage = pd.nFromPage
        ToPage = pd.nToPage
        PrintToFile = (pd.flags And PD_PRINTTOFILE)
        ' Get DEVMODE structure from PRINTDLG

        Dim pDevMode As Long
        pDevMode = GlobalLock(pd.hDevMode)
        CopyMemory m_dvmode, ByVal pDevMode, Len(m_dvmode)
        GlobalUnlock pd.hDevMode
        If (pd.flags And PD_COLLATE) = PD_COLLATE Then
            ' User selected collate option but printer driver
            ' does not support collation.
            ' Collation option must be set from the
            ' PRINTDLG structure:
            Collate = True
            Copies = pd.nCopies
        Else
            ' Print driver supports collation or collation
            ' not switched on.
            ' DEVMODE structure contains Collation and copy
            ' information
            ' Get Copies and Collate settings from DEVMODE structure
            Collate = (m_dvmode.dmCollate = DMCOLLATE_TRUE)
            Copies = m_dvmode.dmCopies
        End If

        ' Set default printer properties
        On Error Resume Next
        If Not (Printer Is Nothing) Then
            Printer.Copies = Copies
            Printer.Orientation = m_dvmode.dmOrientation
            Printer.PaperSize = m_dvmode.dmPaperSize
            Printer.PrintQuality = m_dvmode.dmPrintQuality
        End If
        On Error GoTo 0
    Case 0
        ' Cancelled
        VBPrintDlg = False
    Case Else
        ' Extended error:
        m_lExtendedError = CommDlgExtendedError()
        VBPrintDlg = False
    End Select

End Function
Private Property Get DevMode() As DevMode
    DevMode = m_dvmode
End Property
Public Function VBPageSetupDlg2( _
        Optional Owner As Long, _
        Optional DisableMargins As Boolean, _
        Optional DisableOrientation As Boolean, _
        Optional DisablePaper As Boolean, _
        Optional DisablePrinter As Boolean, _
        Optional LeftMargin As Single, _
        Optional MinLeftMargin As Single, _
        Optional RightMargin As Single, _
        Optional MinRightMargin As Single, _
        Optional TopMargin As Single, _
        Optional MinTopMargin As Single, _
        Optional BottomMargin As Single, _
        Optional MinBottomMargin As Single, _
        Optional PaperSize As EPaperSize = epsLetter, _
        Optional Orientation As eOrientation = eoPortrait, _
        Optional PrintQuality As EPrintQuality = epqDraft, _
        Optional Units As EPageSetupUnits = epsuInches, _
        Optional Printer As Object, _
        Optional flags As Long, _
        Optional Hook As Boolean = False _
    ) As Boolean
Dim afFlags As Long, afMask As Long

    m_lApiReturn = 0
    m_lExtendedError = 0
    ' Mask out unwanted bits
    afMask = Not (PSD_EnablePagePaintHook Or _
                  PSD_EnablePageSetupHook Or _
                  PSD_EnablePageSetupTemplate)
    ' Set TPAGESETUPDLG flags
    afFlags = (-DisableMargins * PSD_DISABLEMARGINS) Or _
              (-DisableOrientation * PSD_DISABLEORIENTATION) Or _
              (-DisablePaper * PSD_DISABLEPAPER) Or _
              (-DisablePrinter * PSD_DISABLEPRINTER) _
               And afMask
    If (flags And PSD_Defaultminmargins) = PSD_Defaultminmargins Then
        afFlags = afFlags Or PSD_Defaultminmargins
    Else
        afFlags = afFlags Or PSD_MARGINS
    End If
    Dim lUnits As Long
    If Units = epsuInches Then
        afFlags = afFlags Or PSD_INTHOUSANDTHSOFINCHES
        lUnits = 1000
    Else
        afFlags = afFlags Or PSD_INHUNDREDTHSOFMILLIMETERS
        lUnits = 100
    End If

    Dim psd As TPAGESETUPDLG
    ' Fill in PRINTDLG structure
    psd.lStructSize = Len(psd)
    psd.hwndOwner = Owner
    psd.rtMargin.tOp = TopMargin * lUnits
    psd.rtMargin.left = LeftMargin * lUnits
    psd.rtMargin.Bottom = BottomMargin * lUnits
    psd.rtMargin.Right = RightMargin * lUnits
    psd.rtMinMargin.tOp = MinTopMargin * lUnits
    psd.rtMinMargin.left = MinLeftMargin * lUnits
    psd.rtMinMargin.Bottom = MinBottomMargin * lUnits
    psd.rtMinMargin.Right = MinRightMargin * lUnits
    psd.flags = afFlags

    ' Show Print dialog
    If PageSetupDlg(psd) Then
        VBPageSetupDlg2 = True
        ' Return dialog values in parameters
        TopMargin = psd.rtMargin.tOp / lUnits
        LeftMargin = psd.rtMargin.left / lUnits
        BottomMargin = psd.rtMargin.Bottom / lUnits
        RightMargin = psd.rtMargin.Right / lUnits
        MinTopMargin = psd.rtMinMargin.tOp / lUnits
        MinLeftMargin = psd.rtMinMargin.left / lUnits
        MinBottomMargin = psd.rtMinMargin.Bottom / lUnits
        MinRightMargin = psd.rtMinMargin.Right / lUnits

        ' Get DEVMODE structure from PRINTDLG
        Dim dvmode As DevMode, pDevMode As Long
        pDevMode = GlobalLock(psd.hDevMode)
        CopyMemory dvmode, ByVal pDevMode, Len(dvmode)
        GlobalUnlock psd.hDevMode
        PaperSize = dvmode.dmPaperSize
        Orientation = dvmode.dmOrientation
        PrintQuality = dvmode.dmPrintQuality
        ' Set default printer properties
        On Error Resume Next
        If Not (Printer Is Nothing) Then
            Printer.Copies = dvmode.dmCopies
            Printer.Orientation = dvmode.dmOrientation
            Printer.PaperSize = dvmode.dmPaperSize
            Printer.PrintQuality = dvmode.dmPrintQuality
        End If
        On Error GoTo 0
    End If

End Function

' PageSetupDlg wrapper
Function VBPageSetupDlg(Optional Owner As Long, _
                        Optional DisableMargins As Boolean, _
                        Optional DisableOrientation As Boolean, _
                        Optional DisablePaper As Boolean, _
                        Optional DisablePrinter As Boolean, _
                        Optional LeftMargin As Long, _
                        Optional MinLeftMargin As Long, _
                        Optional RightMargin As Long, _
                        Optional MinRightMargin As Long, _
                        Optional TopMargin As Long, _
                        Optional MinTopMargin As Long, _
                        Optional BottomMargin As Long, _
                        Optional MinBottomMargin As Long, _
                        Optional PaperSize As EPaperSize = epsLetter, _
                        Optional Orientation As eOrientation = eoPortrait, _
                        Optional PrintQuality As EPrintQuality = epqDraft, _
                        Optional Units As EPageSetupUnits = epsuInches, _
                        Optional Printer As Object, _
                        Optional flags As Long, _
                        Optional Hook As Boolean = False _
                    ) As Boolean
Dim fLeftMargin As Single
Dim fMinLeftMargin As Single
Dim fRightMargin As Single
Dim fMinRightMargin As Single
Dim fTopMargin As Single
Dim fMinTopMargin As Single
Dim fBottomMargin As Single
Dim fMinBottomMargin As Single

    VBPageSetupDlg2 _
        Owner, _
        DisableMargins, _
        DisableOrientation, _
        DisablePaper, _
        DisablePrinter, _
        fLeftMargin, _
        fMinLeftMargin, _
        fRightMargin, _
        fMinRightMargin, _
        fTopMargin, _
        fMinTopMargin, _
        fBottomMargin, _
        fMinBottomMargin, _
        PaperSize, _
        Orientation, _
        PrintQuality, _
        Units, _
        Printer, _
        flags
    LeftMargin = fLeftMargin
    MinLeftMargin = fMinLeftMargin
    RightMargin = fRightMargin
    MinRightMargin = fMinRightMargin
    TopMargin = fTopMargin
    MinTopMargin = fMinTopMargin
    BottomMargin = fBottomMargin
    MinBottomMargin = fMinBottomMargin
End Function

#If fComponent = 0 Then
Private Sub ErrRaise(e As Long)
    Dim sText As String, sSource As String
    If e > 1000 Then
        sSource = App.EXEName & ".CommonDialog"
        Err.Raise COMError(e), sSource, sText
    Else
        ' Raise standard Visual Basic error
        sSource = App.EXEName & ".VBError"
        Err.Raise e, sSource
    End If
End Sub
#End If


Private Sub StrToBytes(ab() As Byte, s As String)
    If IsArrayEmpty(ab) Then
        ' Assign to empty array
        ab = StrConv(s, vbFromUnicode)
    Else
        Dim cab As Long
        ' Copy to existing array, padding or truncating if necessary
        cab = UBound(ab) - LBound(ab) + 1
        If Len(s) < cab Then s = s & String$(cab - Len(s), 0)
        'If UnicodeTypeLib Then
        '    Dim st As String
        '    st = StrConv(s, vbFromUnicode)
        '    CopyMemoryStr ab(LBound(ab)), st, cab
        'Else
            CopyMemoryStr ab(LBound(ab)), s, cab
        'End If
    End If
End Sub


Public Function BytesToStr(ab() As Byte) As String
    BytesToStr = StrConv(ab, vbUnicode)
End Function

Private Function COMError(e As Long) As Long
    COMError = e Or vbObjectError
End Function
'
Private Function IsArrayEmpty(va As Variant) As Boolean
    Dim v As Variant
    On Error Resume Next
    v = va(LBound(va))
    IsArrayEmpty = (Err <> 0)
End Function











'********************************************************************************
'顯示保存附件,保存文件對話框
Public Function pSaveMailAs(ByVal sName As String, lngParentHwndID As Long) As String
Dim sTitle As String

Dim iPos As Integer
Dim iFilterIndex As Long
Dim sExt As String
Dim bHtml As Boolean


'   sName = App.Path & "\" & sName
   iFilterIndex = 1
   VBGetSaveFileName sName, _
      sTitle, True, _
      "email (*.eml)" + Chr$(0) + "*.eml" & Chr$(0) + "網頁文件(*.html)" + Chr$(0) + "*.html" + Chr$(0) + "文本文件(*.txt)" + Chr$(0) + "*.txt" + Chr$(0), _
      iFilterIndex, _
      App.Path, _
      "保存列表文件", _
       "eml", _
      lngParentHwndID, _
      OFN_PATHMUSTEXIST Or OFN_NOREADONLYRETURN


   pSaveMailAs = sName
   
   


End Function
'********************************************************************************







'********************************************************************************
'顯示保存附件,保存文件對話框
Public Function pGetFileName(strFilter As String, lngParentHwnd As Long) As String
Dim sTitle As String

Dim iPos As Integer
Dim iFilterIndex As Long
Dim sExt As String
Dim bHtml As Boolean

   iFilterIndex = 1

   VBGetOpenFileName pGetFileName, _
      sTitle, True, False, True, True, strFilter, _
      iFilterIndex, _
      App.Path, "打開", _
       "eml", lngParentHwnd, _
      OFN_PATHMUSTEXIST Or OFN_NOREADONLYRETURN

   pGetFileName = pGetFileName
End Function
'********************************************************************************