Jump to content
Sign in to follow this  
startuga

[Resolvido] Anexar ficheiros

Recommended Posts

startuga

Boas pessoal,

Tenho este código

Const msoFileDialogOpen = 1
Set fso = CreateObject("Scripting.FileSystemObject")
Set objWord = CreateObject("Word.Application")
Set WshShell = CreateObject("WScript.Shell")
strInitialPath = WshShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\"
objWord.ChangeFileOpenDirectory (strInitialPath)
With objWord.FileDialog(msoFileDialogOpen)
.Title = "Select the file to process"
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "All Files", "*.*"
.Filters.Add "Excel Files", "*.xls;*.xlsx"
.Filters.Add "Text Files", "*.txt"
.Filters.Add "Various Files", "*.xls;*.doc;*.vbs"
If .Show = -1 Then
For Each File In .SelectedItems
Set objFile = fso.GetFile(File)
filepath = objFile
Next
Else
End If
End With

Através do mesmo consigo anexar 1 a um email, alguem pode ajudar a complementar o código por forma a conseguir anexar mais que um ficheiro?

Obrigaod

Edited by startuga

Share this post


Link to post
Share on other sites
startuga

Boas,

onde é que usas o "filepath" ?

O filepath : Dim filepath As String

Chamo quando mando o email

.Attachments.Add (filepath)

Share this post


Link to post
Share on other sites
nelsonr

Então tens de fazer esse .Attachments.Add (filepath) dentro do foreach.

Algo assim:

For Each File In .SelectedItems
objectoMail.Attachments.Add (fso.GetFile(File))
Next

O objectoMail será o objecto da mensagem que deves ter ai algures

Ou então, usas esse filepath como array e preenches nesse foreach.

Isso é mesmo VBA ou VB.NET?

Share this post


Link to post
Share on other sites
startuga

Então tens de fazer esse .Attachments.Add (filepath) dentro do foreach.

Algo assim:

For Each File In .SelectedItems
objectoMail.Attachments.Add (fso.GetFile(File))
Next

O objectoMail será o objecto da mensagem que deves ter ai algures

Ou então, usas esse filepath como array e preenches nesse foreach.

Isso é mesmo VBA ou VB.NET?

É VBA,

Share this post


Link to post
Share on other sites
startuga

Então tens de fazer esse .Attachments.Add (filepath) dentro do foreach.

Algo assim:

For Each File In .SelectedItems
objectoMail.Attachments.Add (fso.GetFile(File))
Next

O objectoMail será o objecto da mensagem que deves ter ai algures

Ou então, usas esse filepath como array e preenches nesse foreach.

Isso é mesmo VBA ou VB.NET?

Como assim usar o filepath como array e preencher no for each?

P.s

Para cada new attach tenho de criar uma nova linha : ".Attachments.Add (filepath)"

Share this post


Link to post
Share on other sites
startuga

Este é todo o meu código até agora, não consigo implementar o for each file :c

Private Sub CommandButton4_Click()
Const msoFileDialogOpen = 1
Set fso = CreateObject("Scripting.FileSystemObject")
Set objWord = CreateObject("Word.Application")
Set WshShell = CreateObject("WScript.Shell")
strInitialPath = WshShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\"
objWord.ChangeFileOpenDirectory (strInitialPath)
With objWord.FileDialog(msoFileDialogOpen)
.Title = "Select the file to process"
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "All Files", "*.*"
.Filters.Add "Excel Files", "*.xls;*.xlsx"
.Filters.Add "Text Files", "*.txt"
.Filters.Add "Various Files", "*.xls;*.doc;*.vbs"
If .Show = -1 Then

For Each file In .SelectedItems
Set objFile = fso.GetFile(file)
filepath = objFile
Next
Else
End If
End With
End Sub
Private Sub CommandButton3_Click()
NUser = Application.GetNamespace("MAPI").CurrentUser
FirstName = Right(NUser, Len(NUser) - 1 - InStr(1, NUser, ",", vbTextCompare))
LastName = Left(NUser, InStr(1, NUser, ",", vbTextCompare) - 1)
Dim strBody As String
Dim objOut As Outlook.Application
Dim objTask As Outlook.TaskItem
Dim blnCrt As Boolean

Set objoutlook = CreateObject("Outlook.Application")
Set objMail = objoutlook.CreateItem(0)
strBody = " Informações de utilizador e computador" & vbNewLine & vbNewLine & _
		 "Utilizador:" & FirstName & " " & LastName & (TextBox4.Text) & vbNewLine & _
		  "Departamento: " & (TextBox6.Text) & vbNewLine & _
		  "Computador: " & (TextBox7.Text) & vbNewLine & _
		  "Sistema Operativo: " & (TextBox10.Text) & vbNewLine & vbNewLine & vbNewLine & _
		  "Prioridade da Situação: " & (ComboBox5.Value) & "								 " & "Tipo de Equipamento: " & (ComboBox6.Value) & "								 " & "Categoria: " & (ComboBox1.Value) & "					  " & "Tipo de Intervenção Necessária: " & (ComboBox3.Value) & vbNewLine & vbNewLine & vbNewLine & _
		  "Descrição do Problema:" & vbNewLine & vbNewLine & (TextBox11) & vbNewLine & vbNewLine & vbNewLine


On Error Resume Next
Select Case True
Case ComboBox5.Value = "Baixa"
On Error GoTo CreateOutlook
Set objOut = GetObject(, "Outlook.Application")
CreateItem:
On Error GoTo 0
Set objTask = objOut.CreateItem(olTaskItem)
With objTask
.Assign
.Importance = olImportanceLow
.subject = "Help Desk"
.body = strBody
.Mileage = FirstName & " " & LastName & " " & "(" & (TextBox4.Text) & ")"
.BillingInformation = TextBox6.Text
.Companies = ComboBox1.Value
On Error Resume Next
.Attachments.Add (filepath)
On Error Resume Next
.Attachments.Add (myattach)
On Error Resume Next
.Attachments.Add (myattach1)
.Recipients.Add ("email@email.com")
.Send
End With
On Error Resume Next
Kill "C:\Temp\*_attach.png"
End
If blnCrt = True Then objOut.Quit
Set objTask = Nothing
Set objOut = Nothing
Exit Sub
End

Share this post


Link to post
Share on other sites
nelsonr

Experimenta fazer estas alterações (não testei):

- Altera a definição da variavel filepath para array

Dim filepath() As String

- No foreach, altera para:

Redim filepath(.SelectedItems.Count)
Dim num as Tnteger
num = 1
For Each file In .SelectedItems
Set objFile = fso.GetFile(file)
filepath(num) = objFile
num = num + 1
Next

- Depois sustituis a parte onde anexas o filepath para:

If UBound(filepath)>0 Then
   For fileNum = 1 To UBound(filepath)
       .Attachments.Add (filepath(fileNum)
   Next
End If

Share this post


Link to post
Share on other sites
startuga

Obrigado Nelson, funiconou bastante bem.

Apenas mais uma questão, para que ele reconhece e faça o count de mais que um file, eu tenho que os selecionar todos de 1x só pois se selecionar um e der ok e for selecionar outro ele não contabliza o ficheiro selecionado anteriormente.

Existe alguma forma de contornar issso?

Share this post


Link to post
Share on other sites
nelsonr

Podes experimentar assim (não testado):

Dim num as Tnteger
num = Ubound(filepath)
Redim filepath(num + .SelectedItems.Count)
For Each file In .SelectedItems
    Set objFile = fso.GetFile(file)
    num = num + 1
    filepath(num) = objFile
Next

Share this post


Link to post
Share on other sites
nelsonr

Experimenta alterar a definição do filepath para

Dim filepath(0) As String

Share this post


Link to post
Share on other sites
nelsonr

Ok, é o que dá fazer exemplos sem testar :D

Altera a definição novamente para

Dim filepath() As String

e tens o Form_Load? Se tiveres coloca lá

Redim filepath(0)

Share this post


Link to post
Share on other sites
nelsonr

Puseste o ReDim no form_load? e está a passar lá antes de ir para essa parte de selecionar os ficheiros?

Share this post


Link to post
Share on other sites
startuga

Isto é VBA não tenho form_load :/

O que tenhoe está assim:

Dim filepath() As String

Private Sub CommandButton4_Click()
Const msoFileDialogOpen = 1
Set fso = CreateObject("Scripting.FileSystemObject")
Set objWord = CreateObject("Word.Application")
Set WshShell = CreateObject("WScript.Shell")
strInitialPath = WshShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\"
objWord.ChangeFileOpenDirectory (strInitialPath)
With objWord.FileDialog(msoFileDialogOpen)
.Title = "Select the file to process"
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "All Files", "*.*"
.Filters.Add "Excel Files", "*.xls;*.xlsx"
.Filters.Add "Text Files", "*.txt"
.Filters.Add "Various Files", "*.xls;*.doc;*.vbs"
If .Show = -1 Then

Dim num As Integer
num = UBound(filepath)
ReDim filepath(0, (num + .SelectedItems.Count))
For Each file In .SelectedItems
	    Set objFile = fso.GetFile(file)
	    num = num + 1
	    filepath(num) = objFile
Next


Else
End If
End With
End Sub

Share this post


Link to post
Share on other sites
nelsonr

Pois, não consigo testar aqui.

Então vai-se por outro caminho, coloca assim:

Dim num As Integer
on error resume next
num = UBound(filepath)
on error goto 0
ReDim filepath(0, (num + .SelectedItems.Count))

Share this post


Link to post
Share on other sites
startuga

Subscript out of range - error 9

 
filepath(num) = objFile

Edited by startuga

Share this post


Link to post
Share on other sites
nelsonr

Ui, espera, que houve um problema de copy/paste

Dim num As Integer
on error resume next
num = UBound(filepath)
on error goto 0
ReDim filepath(num + .SelectedItems.Count)

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Sign in to follow this  

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.