GetTempPath VBA可在64位笔记本电脑上运行,但不能在32位台式机上运行

时间:2019-11-26 16:09:40

标签: excel vba temp

我创建了一个Excel工作表,该工作表具有用户填写的表单。在按钮上单击它应该会生成一个要通过电子邮件发送的副本,它在我的64位笔记本电脑上可以正常工作,但是当我尝试在我们的32位台式机之一上运行它时,显示错误“编译错误-找不到项目或库”突出显示GetTempPath。我已经尝试过TempFilePath = Environ $(“ temp”)&“ \”,但这仍然会引发相同的错误。通过命令提示符查看两个环境的TEMP和TMP路径是否相同。

{
Sub CommandButton1_Click()
If (Range("C7") = Empty) Or (Range("C11") = Empty) Or (Range("C15") = Empty) Or (Range("C19") = 
Empty) Or (Range("C23") = Empty) Or (Range("C27") = Empty) Or (Range("C32") = Empty) Or 
(Range("C41") = Empty) Or (Range("C45") = Empty) Then
MsgBox "Mandatory fields require input"
Else
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
Sheets("Data").Visible = True
Sheets("Data").Activate
ActiveSheet.Range("A2:K2").Select
Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

'Copy the ActiveSheet to a new workbook
Sheets("Data").Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
   If Val(Application.Version) < 12 Then
      'You use Excel 97-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007-2016
        Select Case Sourcewb.FileFormat
        Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
        Case 52:
            If .HasVBProject Then
                FileExtStr = ".xlsm": FileFormatNum = 52
            Else
                FileExtStr = ".xlsx": FileFormatNum = 51
            End If
        Case 56: FileExtStr = ".xls": FileFormatNum = 56
        Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
       End Select
   End If
End With

'Save the new workbook/Mail it/Delete it
TempFilePath = GetTempPath
TempFileName = Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With Destwb
    .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
    On Error Resume Next
    With OutMail
        .to = Range("A100")
        .CC = ""
        .BCC = ""
        .Subject = "Referral"
        .Body = "Hi there, see attached form."
        .Attachments.Add Destwb.FullName
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    End With
    On Error GoTo 0
    .Close SaveChanges:=False
End With

MsgBox ("Submitted, Thank you")
'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr
Sourcewb.Close SaveChanges:=False

Set OutMail = Nothing
Set OutApp = Nothing

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
End If
End Sub
}

0 个答案:

没有答案