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

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
Now I am loosing my faith from this site... I think, Expert people are not available on this site. I have not received any reply on my few last questions.
 
Upvote 0
Hi Andrew,

I am not stucking anywhere in this code. Code runs fine but when i open my file after closing then popup the below massage.

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.

 
Upvote 0
Yes Andrew.. There is no detailed information available..

I have disposed perfectly each object in my vba code but I do not know that what am I missing in this.

If you want then I can send you the file. Please share your email id...
 
Upvote 0
in order to narrowdown the bugged part. you should make a duplicated version of the file. then remove all the code in it. then open it and check if the bug is still there. if no, put a half of your code back to the xml file, see if there is an error. if yes, remove half of the code of that xml so as to narrow down the bugged part. if not, test the other half of the code with the same method.
with this method, you should be able to find which code is bugged.
 
Upvote 0
How do you know that the problem relates to your VBA code? And what's in the dialog that shows an xml file path?
 
Upvote 0
Yes Andrew.. There is no detailed information available..

I have disposed perfectly each object in my vba code but I do not know that what am I missing in this.

If you want then I can send you the file. Please share your email id...

i can have a look at your file too. if you are willing to give me the credits, you can also send it to me. my email is
sales03@pcbway.net
 
Upvote 0

Forum statistics

Threads
1,215,184
Messages
6,123,533
Members
449,106
Latest member
techog

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