none
Export as CSV file! RRS feed

  • Question

  • Hi

    i am not getting results as per my requirement & i also required some modification it.
    half of code working fine, in column i, Q & M data is coping fine its static/fix data column A is also good and fine & other data will come up or copy from sam file to exported WBK!

    below part isn't working!


    column B of sam file will go to column N in exported file, column C of sam file will go to column W, column D of sam file will go to column R, column E of sam file will go to column O, column F of sam file will go to column K.

    below is change/modification which i required.

    when i run code i want one dialog box for pre number for column A, which number i will paste/write in that will become first digit of column A data for example i write 1 than 1 will be leading number of each cell if i leave blank than only column A data will copy as it is(only will remove dashes and spaces already in code) & total count of cell will be 11.
    14311234560
    14311234561
    14311234562

    second in column C sam file if there is only three letter than its will export with leading 0 only in sample like 0555, 0495

    all other thing will remain safe.

    i attached both files sam file and exported file(grv)

    here exported file sample!

    https://www.dropbox.com/s/zph4ai2z53v4x6m/grv.csv?dl=0

    Sam file sample!

    https://www.dropbox.com/s/6ol9hcz3v65gy3a/sam%20with%20code.xlsm?dl=0

    Sub test()
        Dim cn As Object, rs As Object, x, i As Long, temp As String, rng As Range
        Application.ScreenUpdating = False
        With Sheets("sheet1").Cells(1).CurrentRegion
            Set rng = .Columns(.Columns.Count + 1)
            rng.Formula = "=34568754000+row()-1"
            rng.Cells(1).Value = "ICCID"
        End With
        Set cn = CreateObject("ADODB.Connection")
        Set rs = CreateObject("ADODB.Recordset")
        With cn
            .Provider = "Microsoft.Ace.OLEDB.12.0"
            .Properties("Extended Properties") = "Excel 12.0;HDR=Yes;"
            .Open ThisWorkbook.FullName
        End With
        rs.Open "Select Null As `Cutomer ID`, Format( Replace( Replace(`nums`,' ',''),'-',''),'00000000000') " & _
                "As `Mobile Number`, Null As `Customer Name`, Null As `CNIC`, Null As `Email Address`, " & _
                "Null As `Package Plan`, Null As `Bolton1`, Null As `Buldles`, 'Send For Activation' As " & _
                "`Connection Status`, Null As `Access Level`, 2000 As `Credit Limit`, Null As `Natureof Sales`, " & _
                "'Waiver' As `Deposit Amount/Waiver Code`, `Action` As `Special Line Level Info`, 1000 As " & _
                "`Special Number Charge Type`, Null As `Hand Set`, 'Gift Voucher' As `Special Number Charges`, " & _
                "`ICCID`, Null As `Verified`, Null As `Comments`, Null As `Sales Feedback`," & _
                "Null As `SPOCMSISDN`, '959SP' As `Sales ID` From `Sheet1$`;", cn, 3
        x = rs.GetString(2, , ",", vbCrLf)
        For i = 0 To rs.Fields.Count - 1
            temp = temp & "," & rs.Fields(i).Name
        Next
        Open ThisWorkbook.Path & "\test.csv" For Output As #1
            Print #1, Mid$(temp, 2) & vbCrLf & x
        Close #1
        rng.Clear
        Application.ScreenUpdating = True
        Set cn = Nothing: Set rs = Nothing
    End Sub

    Adeel

    Wednesday, November 27, 2019 11:14 AM

All replies

  • Any one could Help! please
    Thursday, November 28, 2019 4:56 AM
  • any one please!
    Thursday, November 28, 2019 2:43 PM
  • may someone can offer help please

    Adeel 

    Saturday, November 30, 2019 8:28 AM
  • i manage some of code my self to correct now data is going in right places/Columns!

    any one can add below part in code !

    when i run code i want one dialog box for pre number for column A, which number i will paste/write in that will become first digit of column A data for example i write 1 than 1 will be leading number of each cell if i leave blank than only column A data will copy as it is(only will remove dashes and spaces already in code) & total count of cell will be 11.
    14311234560
    14311234561
    14311234562

    Option Explicit
    
    Sub test()
        Dim cn As Object, rs As Object, x, i As Long, temp As String, rng As Range
        Application.ScreenUpdating = False
        With Sheets("sheet1").Cells(1).CurrentRegion
            Set rng = .Columns(.Columns.Count + 1)
            Columns("R:R").NumberFormat = "@"
        End With
        Set cn = CreateObject("ADODB.Connection")
        Set rs = CreateObject("ADODB.Recordset")
        With cn
            .Provider = "Microsoft.Ace.OLEDB.12.0"
            .Properties("Extended Properties") = "Excel 12.0;HDR=Yes;"
            .Open ThisWorkbook.FullName
        End With
        rs.Open "Select Null As `Cutomer ID`, Format( Replace( Replace(`nums`,' ',''),'-',''),'000000000000') " & _
                "As `Mobile Number`,Null As `Customer Name`,Null As `CNIC`,Null As `Email Address`, " & _
                "Null As `Package Plan`,Null As `Bolton1`,Null As `Buldles`,'Send For Activation' As " & _
                "`Connection Status`,Null As `Access Level`,`CL` As `Credit Limit`,Null As `Natureof Sales`, " & _
                "'Waiver' As `Deposit Amount/Waiver Code`,`Action` As `Special Line Level Info`,`Num Price` As " & _
                "`Special Number Charge Type`,Null As `Hand Set`,'Gift Voucher' As `Special Number Charges`, " & _
                "`Imsi` As `ICCID`, Null As `Verified`, Null As `Comments`, Null As `Sales Feedback`," & _
                "Null As `SPOCMSISDN`,`ID` As`Sales ID` From `Sheet1$`;", cn, 3
        x = rs.GetString(2, , ",", vbCrLf)
        For i = 0 To rs.Fields.Count - 1
            temp = temp & "," & rs.Fields(i).Name
        Next
        Open ThisWorkbook.Path & "\grv.csv" For Output As #1
            Print #1, Mid$(temp, 2) & vbCrLf & x
        Close #1
        rng.Clear
        Application.ScreenUpdating = True
        Set cn = Nothing: Set rs = Nothing
    End Sub

    Adeel


    • Edited by Adeeeel Monday, December 2, 2019 5:15 AM
    Monday, December 2, 2019 5:15 AM
  • any one please!
    Sunday, December 8, 2019 10:09 AM