0 Replies - 1597 Views - Last Post: 21 June 2012 - 09:17 AM

#1 barrettdavis01  Icon User is offline

  • New D.I.C Head

Reputation: 0
  • View blog
  • Posts: 1
  • Joined: 21-June 12

Access to Excel, too many columns are being created in the spreadsheet

Posted 21 June 2012 - 09:17 AM

Hello,

I am relatively new to MS access. I have coded an application and it is creating a total of 16,000 columns instead of 16-24. I was hoping some one could define the problem. Thank you for your help.



Private Sub cmdSaveXLS_Click()
Dim db As Database
Dim rst As DAO.Recordset
Dim rst1 As DAO.Recordset
Dim rst2 As DAO.Recordset
Set db = CurrentDb()
Dim RequiredKey As String
Dim str As String
Dim str2 As String
Dim str3 As String
Set rst = db.OpenRecordset("SearchTbl", dbOpenDynaset)
Set rst1 = db.OpenRecordset("tblLockedCab", dbOpenDynaset)
Do Until rst.EOF
    rst.Edit
    If rst!SelectItem = 0 Then
        rst.Delete
        rst.MoveNext
    Else
    '
    'determine if the cabinet that contains the equipment requires a key to unlock the cabinet
    '
        str = "CabName = '" & rst!RemCabName & "'"
        rst1.FindFirst str
        If Not rst1.NoMatch Then
            If InStr(1, RequiredKey, rst!RemCabName, vbTextCompare) = 0 Then
                RequiredKey = RequiredKey & rst!RemCabName & " Key - " & rst1!Key & ", "
                str2 = "Cabinet = " & rst!RemCabName & "  Key = " & rst1!Key & "  "
                str3 = str3 + str2
                rst.MoveNext
            Else
                rst.MoveNext
            End If
        Else
            rst.MoveNext
        End If
    End If
Loop
rst.MoveFirst

If Me.ActiveControl.Name Like "*VM*" Then
    WOFileName = InputBox("Please enter the file name to save this Virtual Spread Sheet to!", "Filename", "Virtual Search Results")
Else
    WOFileName = InputBox("Please enter the file name to save this file to!", "Filename", "Wild Card Search Results")
End If
If IsNull(WOFileName) Or WOFileName = "" Then Exit Sub
If Me.ActiveControl.Name Like "*VM*" Then
    DoCmd.OutputTo acOutputQuery, "qryVMList", acFormatXLS, "c:\Documents and Settings\All Users\Desktop\" & WOFileName & ".xlsx"
Else
    DoCmd.OutputTo acOutputQuery, "qrySearchTblGatewaySubnetMas1", acFormatXLSX, "c:\Documents and Settings\All Users\Desktop\" & WOFileName & ".xlsx"
End If
Dim appExcel As New Excel.Application
Dim appWBs As Excel.Workbooks
Dim appWB As Excel.Workbook
Dim Hgt As Integer

Set appExcel = Excel.Application
Set appWBs = appExcel.Workbooks
appExcel.Visible = True

'THIS IS WHERE ERROR IS !'

'16384 rows created. 16 is the maximum number of needed table





Workbooks.Open FileName:="c:\Documents and Settings\All Users\Desktop\" & WOFileName & ".xlsx"
With Worksheets("qrySearchTblGatewaySubnetMas1")
    .Cells.Select
    .Cells.Rows.RowHeight = 12
    .Cells.Font.Size = 9
    .PageSetup.Orientation = xlLandscape
    .PageSetup.LeftMargin = 0
    .PageSetup.RightMargin = 0
    .Rows("1").RowHeight = 25
    .Rows("1").Cells.WrapText = True
    .Columns.AutoFit
    .Columns("B").ColumnWidth = 3
    .Columns("J").ColumnWidth = 5
    .Columns("K").ColumnWidth = 5
    .Columns.Cells.HorizontalAlignment = xlCenter
    Cells.Sort Key1:=Range("G2"), Order1:=xlAscending, Key2:=Range("A2"), Order2:=xlAscending, Header:=xlYes
    '.Cells.Borders.LineStyle = xlContinuous
    .Cells.Borders.Weight = xlThin
End With
    Range("A1").End(xlDown).Select
    ActiveCell.Offset(rowoffset:=2).Activate
   ActiveCell = "Virtual Device List"
    ActiveCell.Cells.Font.Bold = True
    ActiveCell.Offset(columnoffset:=5).Activate
ActiveCell = "Virtual Device"
    ActiveCell.Cells.Font.Bold = True
    ActiveCell.Offset(columnoffset:=1).Activate
    ActiveCell = "Virtual Name"
    ActiveCell.Cells.Font.Bold = True
    ActiveCell.Offset(columnoffset:=-6).Activate
    ActiveCell.Offset(rowoffset:=1).Activate
    
    
Set rst = db.OpenRecordset("Select distinct RemoteDevice from SearchTbl", dbOpenDynaset)
rstcount = rst.RecordCount
Do Until rst.EOF

    Set rst2 = db.OpenRecordset("Select * from qryRelWirVir where RemoteDevice = '" & rst!RemoteDevice & "'", dbOpenDynaset)
    If rst2.RecordCount <> 0 Then
        Do Until rst2.EOF
            ActiveCell.Offset(, columnoffset:=5).Activate
            ActiveCell = rst2!RemoteDevice
            ActiveCell.Offset(, columnoffset:=1).Activate
            ActiveCell = rst2!VirName
            ActiveCell.Offset(, columnoffset:=4).Activate
            'ActiveCell.Offset(rowoffset:=1).Activate
            ActiveCell = rst2!RemoteIPAddress
            ActiveCell.Offset(rowoffset:=1).Activate
            ActiveCell.Offset(, columnoffset:=-10).Activate
        rst2.MoveNext
        Loop
    End If
rst.MoveNext
Loop

MoveOn:
ActiveCell.Offset(rowoffset:=2).Activate
If Len(str3) > 0 Then
    ActiveCell = "Cabinet Key List" & Chr(10) & str3
    ActiveCell.Cells.Font.Bold = True
    Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(ActiveCell.Row, 14)).Cells.MergeCells = True
    ActiveCell.Rows.RowHeight = 50
    ActiveCell.WrapText = True
End If


With Worksheets("qrySearchTblGatewaySubnetMas1")
    .Rows("1").Insert
    .Rows("1").Borders.LineStyle = None
    .Rows("1").HorizontalAlignment = xlLeft
    .Cells(1, 1) = WOFileName & ".xlsx"
    .Rows("2").Insert
    .Rows("2").Borders.LineStyle = None
    
End With
rst.Close
rst1.Close
rst2.Close
Me.SelectAll = 0
End Sub




Is This A Good Question/Topic? 0
  • +

Page 1 of 1