VBA Excel File Issue - During opening

krishnaoptif

Board Regular
Joined
Sep 17, 2010
Messages
140
Hi Experts,

I get below error msg sometime when i open my excel file which has vba code in it.
Error msg: "We found a problem with some content in 'my excel file.xlsb'. Do you want us to try to recover as much as we can? If you trust the source of this workbook, Click Yes."

then i always click on yes button and then save as this file again. It also give me one dialog box where show a xml file path.

I am using below VBA code in my this Excel file.


Code:
Option Explicit


'Production
Const SharePointUrl = "http://Mysite/TeamSite/"
Const ListNameOrGuid = "{C6946GC2-1433-4244-94D5-A9EE449E480F}"
Const ViewNameOrGuid = "{BD08G78A-6E68-480D-8B51-14F0030F6106}"




Sub ImportSharePointList(StrSharePointUrl As String, strListNameOrGuid As String, strViewNameOrGuid As String, SheetName As String)
        '=======================================================================
        '   Variable ini and get data into sheet from sharepoint
        '=======================================================================
        Dim objMyList As ListObject
        Dim objWksheet As Worksheet
        Set objWksheet = Worksheets(SheetName)
        objWksheet.Visible = True
        objWksheet.Activate
        objWksheet.Cells.Delete
        Set objMyList = objWksheet.ListObjects.Add(xlSrcExternal, Array(StrSharePointUrl & "/_vti_bin", strListNameOrGuid, strViewNameOrGuid), False, , Range("A1"))
        'Set objWksheet = Nothing
        'objWksheet.Visible = False
End Sub


Sub Download_SPlist()
    
    Call ImportSharePointList(SharePointUrl, ListNameOrGuid, ViewNameOrGuid, Sht_SP.Name)


    
End Sub


Sub SyncDataToSharePoint()
        
        
        Sht_Instructions.Range("F14").Value = Now()
        
        '=======================================================================
        '   Variable ini
        '=======================================================================
        Dim lRow As Long
        Dim str As String
        
        Dim str_RecordID As String
        Dim str_CSR As String
        Dim str_CODate As String
        Dim str_InforCO As String
        Dim str_Cust As String
        Dim str_CustName As String
        Dim str_OrderValue As String
        Dim str_CustPO As String
        Dim str_COShipDate As String
        Dim str_WHCode As String
        Dim str_OrderStatus As String
        Dim str_OrderHeld As String
        
        lRow = 2
        str = Sht_SyncToSP.Cells(lRow, 1).Value
        While str <> ""
            
            
            '=======================================================================
            '   Delete Item from the SharePoint List
            '=======================================================================
            If str = "Not in Open & Closed Infor" Then
                Call Delete_ItemInSharePointList(SharePointUrl, ListNameOrGuid, Sht_SyncToSP.Cells(lRow, 2).Value)
                        
            ElseIf str = "New" Or str = "New+Hold" Then
                '=======================================================================
                '   Add Item into the SharePoint List
                '=======================================================================
                str_CSR = Replace(Sht_SyncToSP.Cells(lRow, 3).Value, "&", "&")
                str_CODate = Sht_SyncToSP.Cells(lRow, 4).Value
                str_InforCO = Sht_SyncToSP.Cells(lRow, 5).Value
                str_Cust = Sht_SyncToSP.Cells(lRow, 6).Value
                str_CustName = Replace(Sht_SyncToSP.Cells(lRow, 7).Value, "&", "&")
                str_OrderValue = Sht_SyncToSP.Cells(lRow, 8).Value
                str_CustPO = Replace(Sht_SyncToSP.Cells(lRow, 9).Value, "&", "&")
                str_COShipDate = Sht_SyncToSP.Cells(lRow, 10).Value
                str_WHCode = Sht_SyncToSP.Cells(lRow, 11).Value
                str_OrderStatus = Replace(Sht_SyncToSP.Cells(lRow, 12).Value, "&", "&")
                str_OrderHeld = Sht_SyncToSP.Cells(lRow, 13).Value
                
                Call Add_ItemInSharePointList(SharePointUrl, ListNameOrGuid, str_CSR, str_CODate, str_InforCO, str_Cust, str_CustName, str_OrderValue, str_CustPO, str_COShipDate, str_WHCode, str_OrderStatus, str_OrderHeld)
            
            Else
                
                '=======================================================================
                '   Add Item into the SharePoint List
                '=======================================================================
                str_RecordID = Sht_SyncToSP.Cells(lRow, 2).Value
                str_CSR = Replace(Sht_SyncToSP.Cells(lRow, 3).Value, "&", "&")
                str_CODate = Sht_SyncToSP.Cells(lRow, 4).Value
                str_InforCO = Sht_SyncToSP.Cells(lRow, 5).Value
                str_Cust = Sht_SyncToSP.Cells(lRow, 6).Value
                str_CustName = Replace(Sht_SyncToSP.Cells(lRow, 7).Value, "&", "&")
                str_OrderValue = Sht_SyncToSP.Cells(lRow, 8).Value
                str_CustPO = Replace(Sht_SyncToSP.Cells(lRow, 9).Value, "&", "&")
                str_COShipDate = Sht_SyncToSP.Cells(lRow, 10).Value
                str_WHCode = Sht_SyncToSP.Cells(lRow, 11).Value
                str_OrderStatus = Replace(Sht_SyncToSP.Cells(lRow, 12).Value, "&", "&")
                str_OrderHeld = Sht_SyncToSP.Cells(lRow, 13).Value
                
                Call Update_ItemInSharePointList(SharePointUrl, ListNameOrGuid, str_RecordID, str_CSR, str_CODate, str_InforCO, str_Cust, str_CustName, str_OrderValue, str_CustPO, str_COShipDate, str_WHCode, str_OrderStatus, str_OrderHeld)
            
            End If
            
            lRow = lRow + 1
            str = Sht_SyncToSP.Cells(lRow, 1).Value
        Wend
        Sht_Instructions.Range("G14").Value = Now()


End Sub










Sub Delete_ItemInSharePointList(StrSharePointUrl As String, strListNameOrGuid As String, RecordID As String)
        '=======================================================================
        '   Variable ini
        '=======================================================================
         Dim objXMLHTTP As MSXML2.XMLHTTP
         'Dim objXMLHTTP As Object
         
         Dim strBatchXml As String
         Dim strSoapBody As String
            
        '=======================================================================
        '   Create new object
        '=======================================================================
        Set objXMLHTTP = New MSXML2.XMLHTTP
        'Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
        
        '=======================================================================
        '   Delete item with internal ID
        '=======================================================================
        'strBatchXml = "<Batch OnError='Continue'><Method ID='1' Cmd='Delete'><Field Name='ID'>" + RecordID + "</Field></Method></Batch>"
        strBatchXml = "<Batch OnError='Continue'><Method ID='1' Cmd='Delete'><Field Name='ID'>" + RecordID + "</Field></Method></Batch>"
        
        objXMLHTTP.Open "POST", StrSharePointUrl + "_vti_bin/Lists.asmx", False
        objXMLHTTP.setRequestHeader "Content-Type", "text/xml; charset=""UTF-8"""
        objXMLHTTP.setRequestHeader "SOAPAction", "http://schemas.microsoft.com/sharepoint/soap/UpdateListItems"
        
        strSoapBody = "<soap:Envelope xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' " _
          & "xmlns:xsd='http://www.w3.org/2001/XMLSchema' " _
          & "xmlns:soap='http://schemas.xmlsoap.org/soap/envelope/'><soap:Body><UpdateListItems " _
          & "xmlns='http://schemas.microsoft.com/sharepoint/soap/'><listName>" & strListNameOrGuid _
          & "</listName><updates>" & strBatchXml & "</updates></UpdateListItems></soap:Body></soap:Envelope>"
        
        objXMLHTTP.send strSoapBody
        
        'If objXMLHTTP.Status = 200 Then
            ' Do something with response
        'End If
        
        Set objXMLHTTP = Nothing


End Sub






Sub Add_ItemInSharePointList(StrSharePointUrl As String, strListNameOrGuid As String, str_CSR As String, str_CODate As String, str_InforCO As String, str_Cust As String, str_CustName As String, str_OrderValue As String, str_CustPO As String, str_COShipDate As String, str_WHCode As String, str_OrderStatus As String, str_OrderHeld As String)
        '=======================================================================
        '   Variable ini
        '=======================================================================
        
        
        'Dim objXMLHTTP As Object
        Dim objXMLHTTP As MSXML2.XMLHTTP
        
        Dim strBatchXml, strBatchXml2 As String
        Dim strSoapBody As String
        
        '=======================================================================
        '   Set obj
        '=======================================================================
        Set objXMLHTTP = New MSXML2.XMLHTTP
        'Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
        
        strListNameOrGuid = strListNameOrGuid
        
        '=======================================================================
        '   Add a new item
        '=======================================================================
        strBatchXml = "<Batch OnError='Continue'><Method ID='3' Cmd='New'><Field Name='ID'>New</Field><Field Name='CSR'>" + str_CSR + "</Field><Field Name='CO_x0020_Date'>" + Format(CDate(str_CODate), "yyyy-mm-dd HH:MM:SS") + "</Field><Field Name='Title'>" + str_InforCO + "</Field><Field Name='Cust_x0023_'>" + str_Cust + "</Field><Field Name='Cust_x0020_Name'>" + str_CustName + "</Field><Field Name='Order_x0020_Value'>" + str_OrderValue + "</Field><Field Name='Cust_x0020_PO_x0023_'>" + str_CustPO + "</Field><Field Name='CO_x0020_Ship_x0020_Date'>" + Format(CDate(str_COShipDate), "yyyy-mm-dd HH:MM:SS") + "</Field><Field Name='WH_x0020_Code'>" + str_WHCode + "</Field><Field Name='Order_x0020_Status'>" + str_OrderStatus + "</Field><Field Name='Order_x0020_Held'>" + str_OrderHeld + "</Field></Method></Batch>"
        
        objXMLHTTP.Open "POST", StrSharePointUrl + "_vti_bin/Lists.asmx", False
        objXMLHTTP.setRequestHeader "Content-Type", "text/xml; charset=""UTF-8"""
        objXMLHTTP.setRequestHeader "SOAPAction", "http://schemas.microsoft.com/sharepoint/soap/UpdateListItems"
        
        strSoapBody = "<soap:Envelope xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' " _
         & "xmlns:xsd='http://www.w3.org/2001/XMLSchema' " _
         & "xmlns:soap='http://schemas.xmlsoap.org/soap/envelope/'><soap:Body><UpdateListItems " _
         & "xmlns='http://schemas.microsoft.com/sharepoint/soap/'><listName>" & strListNameOrGuid _
         & "</listName><updates>" & strBatchXml & "</updates></UpdateListItems></soap:Body></soap:Envelope>"
        
         objXMLHTTP.send strSoapBody
        
        If objXMLHTTP.Status = 200 Then
           'Do something with response
        End If
        
        Set objXMLHTTP = Nothing


End Sub






Sub Update_ItemInSharePointList(StrSharePointUrl As String, strListNameOrGuid As String, RecordID As String, str_CSR As String, str_CODate As String, str_InforCO As String, str_Cust As String, str_CustName As String, str_OrderValue As String, str_CustPO As String, str_COShipDate As String, str_WHCode As String, str_OrderStatus As String, str_OrderHeld As String)
        '=======================================================================
        '   Variable ini
        '=======================================================================
        
        
        'Dim objXMLHTTP As Object
        Dim objXMLHTTP As MSXML2.XMLHTTP
        
        Dim strBatchXml, strBatchXml2 As String
        Dim strSoapBody As String
        
        '=======================================================================
        '   Set obj
        '=======================================================================
        Set objXMLHTTP = New MSXML2.XMLHTTP
        'Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
        
        strListNameOrGuid = strListNameOrGuid
        
        '=======================================================================
        '   Add a new item
        '=======================================================================
        strBatchXml = "<Batch OnError='Continue'><Method ID='1' Cmd='Update'><Field Name='ID'>" + RecordID + "</Field><Field Name='CSR'>" + str_CSR + "</Field><Field Name='CO_x0020_Date'>" + Format(CDate(str_CODate), "yyyy-mm-dd HH:MM:SS") + "</Field><Field Name='Title'>" + str_InforCO + "</Field><Field Name='Cust_x0023_'>" + str_Cust + "</Field><Field Name='Cust_x0020_Name'>" + str_CustName + "</Field><Field Name='Order_x0020_Value'>" + str_OrderValue + "</Field><Field Name='Cust_x0020_PO_x0023_'>" + str_CustPO + "</Field><Field Name='CO_x0020_Ship_x0020_Date'>" + Format(CDate(str_COShipDate), "yyyy-mm-dd HH:MM:SS") + "</Field><Field Name='WH_x0020_Code'>" + str_WHCode + "</Field><Field Name='Order_x0020_Status'>" + str_OrderStatus + "</Field><Field Name='Order_x0020_Held'>" + str_OrderHeld + "</Field></Method></Batch>"
        
        objXMLHTTP.Open "POST", StrSharePointUrl + "_vti_bin/Lists.asmx", False
        objXMLHTTP.setRequestHeader "Content-Type", "text/xml; charset=""UTF-8"""
        objXMLHTTP.setRequestHeader "SOAPAction", "http://schemas.microsoft.com/sharepoint/soap/UpdateListItems"
        
        strSoapBody = "<soap:Envelope xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' " _
         & "xmlns:xsd='http://www.w3.org/2001/XMLSchema' " _
         & "xmlns:soap='http://schemas.xmlsoap.org/soap/envelope/'><soap:Body><UpdateListItems " _
         & "xmlns='http://schemas.microsoft.com/sharepoint/soap/'><listName>" & strListNameOrGuid _
         & "</listName><updates>" & strBatchXml & "</updates></UpdateListItems></soap:Body></soap:Envelope>"
        
         objXMLHTTP.send strSoapBody
        
        If objXMLHTTP.Status = 200 Then
           'Do something with response
        End If
        
        Set objXMLHTTP = Nothing


End Sub
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Hi Andrew,


I have attached the doc file in google drive in below address where i have attached the snapshot for all the steps and xml file.
https://drive.google.com/open?id=0Bx8Ry12AXZ87THdxZFdaeFVNSkE

Please check
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,207
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top