XLSX TO XLS save attachment

[sal21]

I use thi s code to save .xlsx(excel 2010) in excel 200/2003 but have error!!!!!

Code: Select all

 If InStr(1, objAtt.FileName, "xlsx") > 0 Then                
                    objAtt.SaveAsFile "C:\DATABASE\MF\REPORT_" & _
                                      Format(objItm.ReceivedTime, "yyyymmdd HHMM") & ".XLS", FileFormat:=xlExcel8                
                End If

[HansV]

What does the error message say?

[sal21]

What does the error message say?

[HansV]

Are you running this code from Outlook or from Excel?

[sal21]

Are you running this code from Outlook or from Excel?

vba for excel

[HansV]

SaveAsFile is Outlook VBA; Outlook doesn't know anything about Excel file formats.
You'll have to do the following:
- Save the attachment with its original name (*.xlsx)
- Open it in Excel.
- Use Excel's SaveAs method to save the workbook as an Excel 97-2003 workbook.
- Close the workbook.
- If you wish, delete the .xlsx workbook.

[sal21]

Are you running this code from Outlook or from Excel?

vba for excel

RESOLVED 90%...(YOUR OLD POST)

Code: Select all

For Each objItm In objItms
        If objItm.Attachments.Count > 0 Then
            For Each objAtt In objItm.Attachments
                If InStr(1, objAtt.FileName, "xlsx") > 0 Then
                    strFileName = "C:\DATABASE\MF\VIR_" & _
                                  Format(objItm.ReceivedTime, "yyyymmDD HHMM")
                    objAtt.SaveAsFile strFileName & ".xlsx"
                    Set wbk = Workbooks.Open(strFileName & ".xlsx")
                    wbk.SaveAs FileName:=strFileName & ".xls", FileFormat:=xlExcel8<<<<<<< Apper a message attached
                    wbk.Close SaveChanges:=False
                    Kill strFileName & ".xlsx"
                End If
            Next objAtt
        End If
        CONTA = CONTA + 1
    Next

[HansV]

Does it help if you insert

Application.DisplayAlerts = False

above the SaveAs line, and

Application.DisplayAlerts = True

below it?

[sal21]

Does it help if you insert

Application.DisplayAlerts = False

above the SaveAs line, and

Application.DisplayAlerts = True

below it?

work!!!!!!!!!!!

[sal21]

Does it help if you insert

Application.DisplayAlerts = False

above the SaveAs line, and

Application.DisplayAlerts = True

below it?

Code: Select all

Private Sub LEGGI_VIRGINIO(NOME_FILE)

    Dim cnt As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim stSQL As String
    Dim vaData As Variant
    Dim a(3) As String

    'We can either use a range-name or a cellrange as the source
    'in the SQL-statement.
    stSQL = "SELECT * FROM [PROVA BNT$A2:G27590]"

    'If we, like in this case, retrieve data from a specific range we need
    'to set the property HDR to No which per se mean that it does not exist any
    'fieldnames(columnnames) in the source-sheet.
    Const stCon As String = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
          "Data Source=C:\DATABASE\MF\REPORT_20140318 1814.XLS;" & _
          "Extended Properties=""Excel 8.0;HDR=NO"";"

    'Instantiate and open the ADO COM-server objects.
    Set cnt = New ADODB.Connection
    Set rst = New ADODB.Recordset

    'Open the connection.
    cnt.Open stCon
    'Open and retrieve the recordset.
    rst.Open stSQL, cnt, adOpenForwardOnly, adLockReadOnly, adCmdText

    'Check if data is returned.
    If Not rst.EOF Then
        'Read retrieved recordset into an variant-array.
        vaData = rst.GetRows()
    Else
        MsgBox "No data found!", vbInformation
        GoTo ExitHere
    End If

    'Populate the array with data.

    a(1) = vaData(0, 0)
    a(2) = vaData(1, 0)
    a(3) = vaData(2, 0)


ExitHere:
    'Close and release COM-Objects variables from memory.
    rst.Close
    Set rst = Nothing
    cnt.Close
    Set cnt = Nothing

End Sub

now i need to open the new vbk saved with ado to loop recordst...

2 prob_

- the sheet in select have a blank space into the name

- i need to trap in :

Const stCon As String = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\DATABASE\MF\REPORT_20140318 1814.XLS;" & _
"Extended Properties=""Excel 8.0;HDR=NO"";"

the name of varible NOME_FILE instead REPORT_20140318 1814.XLS

other way are welcomed

[HansV]

Try

Code: Select all

...
    'We can either use a range-name or a cellrange as the source
    'in the SQL-statement.
    stSQL = "SELECT * FROM ['PROVA BNT'$A2:G27590]"

    'If we, like in this case, retrieve data from a specific range we need
    'to set the property HDR to No which per se mean that it does not exist any
    'fieldnames(columnnames) in the source-sheet.
    Const stCon As String = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
          "Data Source=C:\DATABASE\MF\" & NOME_FILE & ";" & _
          "Extended Properties=""Excel 8.0;HDR=NO"";"
...

[sal21]

Try

Code: Select all

...
    'We can either use a range-name or a cellrange as the source
    'in the SQL-statement.
    stSQL = "SELECT * FROM ['PROVA BNT'$A2:G27590]"

    'If we, like in this case, retrieve data from a specific range we need
    'to set the property HDR to No which per se mean that it does not exist any
    'fieldnames(columnnames) in the source-sheet.
    Const stCon As String = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
          "Data Source=C:\DATABASE\MF\" & NOME_FILE & ";" & _
          "Extended Properties=""Excel 8.0;HDR=NO"";"
...

ops...

[HansV]

Change stSQL to a variable and set its value to the same expression.

[sal21]

Change stSQL to a variable and set its value to the same expression.

great!!!!!!!!!!!!!!!!!!!!
TKS GENTLEMEN

But i have fixed the range stSQL = "SELECT * FROM ['PROVA BNT'$A2:G27590]", in 27590, in my case, to be sure to get all cell

is possible to set for example with the a function, similar xlsup, the range from valid an d not empty cells?

[HansV]

Can't you use

Code: Select all

stSQL = "SELECT * FROM ['PROVA BNT'$]"