How to use RANGE Statment - Receiving Error 1004

You must build criteria string from the range for the IN clause:

Sub CBreader()

    'Establish connection and record set with CRMDB
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    
    
    Set cnn = New ADODB.Connection
    Set rst = New ADODB.Recordset
    
    'Dim strSQL As String
    
    'Declare field variables
    Dim GetItem As String
    Dim FPolicy As Range
    Dim FBlock As String
    Dim FMsg As String
    'Dim WS As Worksheet
    
    'Open the ODBC Connection using this statement
    
    With Sheets("EF")
        Set FPolicy = .Range("D7:D" & .Cells(.Rows.Count, 1).End(x1Up).Row).Value
        
        cnn.Open "CRMDB", "XXXXX", "xxxxx"
        rst.ActiveConnection = cnn
        rst.CursorLocation = adUseServer
        
        rst.Source = "Select * FROM u_CloseBlock WHERE [u_CloseBlock].[Policy] in (" & CriteriaFromRange(FPolicy) & ")"
        
        rst.Open
        
        If rst.EOF Then
          GetItem = "Not Found"
        Else
            FPolicy = rst.Fields("Policy")
            FBlock = rst.Fields("Block_No")
        End If
        
        If FBlock = "1011" Then
            FMsg = "Yes"
            .Range("K7", .Range("LastCell")).Value = FMsg
        ElseIf IsNull(FBlock) Then
            FMsg = "No"
            .Range("K7", .Range("LastCell")).Value = FMsg
            
        End If
    End With
    
       
    'Close everything and set the references to nothing
    rst.Close
    Set rst = Nothing
    cnn.Close
    Set cnn = Nothing
     
 End Sub

Function CriteriaFromRange(rgCriteria As Range) As String
   Dim Cell           As Range
   Dim sTemp           As String
   For Each Cell In rgCriteria.Cells
      If Len(Cell.Value) > 0 Then sTemp = sTemp & ",'" & EscapeQuotes(Cell.Value) & "'"
   Next Cell
   ' now strip off leading comma
   CriteriaFromRange = Mid$(sTemp, 2)
End Function
Function EscapeQuotes(sInput As String) As String
   EscapeQuotes = Replace(sInput, "'", "''")
End Function